Theory Forcing_Notions
sectionâ¹Forcing notionsâº
textâ¹This theory defines a locale for forcing notions, that is,
preorders with a distinguished maximum element.âº
theory Forcing_Notions
imports
"ZF-Constructible.Relative"
"Delta_System_Lemma.ZF_Library"
begin
subsectionâ¹Basic conceptsâº
textâ¹We say that two elements $p,q$ are
ââ¹compatible⺠if they have a lower bound in $P$âº
definition compat_in :: "iâiâiâiâo" where
"compat_in(A,r,p,q) â¡ âdâA . â¨d,pâ©âr â§ â¨d,qâ©âr"
lemma compat_inI :
"⦠dâA ; â¨d,pâ©âr ; â¨d,gâ©âr â§ â¹ compat_in(A,r,p,g)"
by (auto simp add: compat_in_def)
lemma refl_compat:
"⦠refl(A,r) ; â¨p,qâ© â r | p=q | â¨q,pâ© â r ; pâA ; qâAâ§ â¹ compat_in(A,r,p,q)"
by (auto simp add: refl_def compat_inI)
lemma chain_compat:
"refl(A,r) â¹ linear(A,r) â¹ (âpâA.âqâA. compat_in(A,r,p,q))"
by (simp add: refl_compat linear_def)
lemma subset_fun_image: "f:NâP â¹ f``NâP"
by (auto simp add: image_fun apply_funtype)
lemma refl_monot_domain: "refl(B,r) â¹ AâB â¹ refl(A,r)"
unfolding refl_def by blast
locale forcing_notion =
fixes P leq one
assumes one_in_P: "one â P"
and leq_preord: "preorder_on(P,leq)"
and one_max: "âpâP. â¨p,oneâ©âleq"
begin
notation one (â¹ðâº)
abbreviation Leq :: "[i, i] â o" (infixl "â¼" 50)
where "x â¼ y â¡ â¨x,yâ©âleq"
lemma refl_leq:
"râP â¹ râ¼r"
using leq_preord unfolding preorder_on_def refl_def by simp
textâ¹A set $D$ is ââ¹dense⺠if every element $p\in P$ has a lower
bound in $D$.âº
definition
dense :: "iâo" where
"dense(D) â¡ âpâP. âdâD . dâ¼p"
textâ¹There is also a weaker definition which asks for
a lower bound in $D$ only for the elements below some fixed
element $q$.âº
definition
dense_below :: "iâiâo" where
"dense_below(D,q) â¡ âpâP. pâ¼q â¶ (âdâD. dâP â§ dâ¼p)"
lemma P_dense: "dense(P)"
by (insert leq_preord, auto simp add: preorder_on_def refl_def dense_def)
definition
increasing :: "iâo" where
"increasing(F) â¡ âxâF. â p â P . xâ¼p â¶ pâF"
definition
compat :: "iâiâo" where
"compat(p,q) â¡ compat_in(P,leq,p,q)"
lemma leq_transD: "aâ¼b â¹ bâ¼c â¹ a â Pâ¹ b â Pâ¹ c â Pâ¹ aâ¼c"
using leq_preord trans_onD unfolding preorder_on_def by blast
lemma leq_transD': "AâP â¹ aâ¼b â¹ bâ¼c â¹ a â A â¹ b â Pâ¹ c â Pâ¹ aâ¼c"
using leq_preord trans_onD subsetD unfolding preorder_on_def by blast
lemma compatD[dest!]: "compat(p,q) â¹ âdâP. dâ¼p â§ dâ¼q"
unfolding compat_def compat_in_def .
abbreviation Incompatible :: "[i, i] â o" (infixl "â¥" 50)
where "p ⥠q ⡠¬ compat(p,q)"
lemma compatI[intro!]: "dâP â¹ dâ¼p â¹ dâ¼q â¹ compat(p,q)"
unfolding compat_def compat_in_def by blast
lemma denseD [dest]: "dense(D) â¹ pâP â¹ âdâD. dâ¼ p"
unfolding dense_def by blast
lemma denseI [intro!]: "⦠âp. pâP â¹ âdâD. dâ¼ p â§ â¹ dense(D)"
unfolding dense_def by blast
lemma dense_belowD [dest]:
assumes "dense_below(D,p)" "qâP" "qâ¼p"
shows "âdâD. dâP â§ dâ¼q"
using assms unfolding dense_below_def by simp
lemma dense_belowI [intro!]:
assumes "âq. qâP â¹ qâ¼p â¹ âdâD. dâP â§ dâ¼q"
shows "dense_below(D,p)"
using assms unfolding dense_below_def by simp
lemma dense_below_cong: "pâP â¹ D = D' â¹ dense_below(D,p) â· dense_below(D',p)"
by blast
lemma dense_below_cong': "pâP â¹ â¦âx. xâP â¹ Q(x) â· Q'(x)â§ â¹
dense_below({qâP. Q(q)},p) â· dense_below({qâP. Q'(q)},p)"
by blast
lemma dense_below_mono: "pâP â¹ D â D' â¹ dense_below(D,p) â¹ dense_below(D',p)"
by blast
lemma dense_below_under:
assumes "dense_below(D,p)" "pâP" "qâP" "qâ¼p"
shows "dense_below(D,q)"
using assms leq_transD by blast
lemma ideal_dense_below:
assumes "âq. qâP â¹ qâ¼p â¹ qâD"
shows "dense_below(D,p)"
using assms refl_leq by blast
lemma dense_below_dense_below:
assumes "dense_below({qâP. dense_below(D,q)},p)" "pâP"
shows "dense_below(D,p)"
using assms leq_transD refl_leq by blast
textâ¹A filter is an increasing set $G$ with all its elements
being compatible in $G$.âº
definition
filter :: "iâo" where
"filter(G) â¡ GâP â§ increasing(G) â§ (âpâG. âqâG. compat_in(G,leq,p,q))"
lemma filterD : "filter(G) â¹ x â G â¹ x â P"
by (auto simp add : subsetD filter_def)
lemma filter_leqD : "filter(G) â¹ x â G â¹ y â P â¹ xâ¼y â¹ y â G"
by (simp add: filter_def increasing_def)
lemma filter_imp_compat: "filter(G) â¹ pâG â¹ qâG â¹ compat(p,q)"
unfolding filter_def compat_in_def compat_def by blast
lemma low_bound_filter:
assumes "filter(G)" and "pâG" and "qâG"
shows "ârâG. râ¼p â§ râ¼q"
using assms
unfolding compat_in_def filter_def by blast
textâ¹We finally introduce the upward closure of a set
and prove that the closure of $A$ is a filter if its elements are
compatible in $A$.âº
definition
upclosure :: "iâi" where
"upclosure(A) â¡ {pâP.âaâA. aâ¼p}"
lemma upclosureI [intro] : "pâP â¹ aâA â¹ aâ¼p â¹ pâupclosure(A)"
by (simp add:upclosure_def, auto)
lemma upclosureE [elim] :
"pâupclosure(A) â¹ (âx a. xâP â¹ aâA â¹ aâ¼x â¹ R) â¹ R"
by (auto simp add:upclosure_def)
lemma upclosureD [dest] :
"pâupclosure(A) â¹ âaâA.(aâ¼p) â§ pâP"
by (simp add:upclosure_def)
lemma upclosure_increasing :
assumes "AâP"
shows "increasing(upclosure(A))"
unfolding increasing_def upclosure_def
using leq_transD'[OF â¹AâPâº] by auto
lemma upclosure_in_P: "A â P â¹ upclosure(A) â P"
using subsetI upclosure_def by simp
lemma A_sub_upclosure: "A â P â¹ Aâupclosure(A)"
using subsetI leq_preord
unfolding upclosure_def preorder_on_def refl_def by auto
lemma elem_upclosure: "AâP â¹ xâA â¹ xâupclosure(A)"
by (blast dest:A_sub_upclosure)
lemma closure_compat_filter:
assumes "AâP" "(âpâA.âqâA. compat_in(A,leq,p,q))"
shows "filter(upclosure(A))"
unfolding filter_def
proof(auto)
show "increasing(upclosure(A))"
using assms upclosure_increasing by simp
next
let ?UA="upclosure(A)"
show "compat_in(upclosure(A), leq, p, q)" if "pâ?UA" "qâ?UA" for p q
proof -
from that
obtain a b where 1:"aâA" "bâA" "aâ¼p" "bâ¼q" "pâP" "qâP"
using upclosureD[OF â¹pâ?UAâº] upclosureD[OF â¹qâ?UAâº] by auto
with assms(2)
obtain d where "dâA" "dâ¼a" "dâ¼b"
unfolding compat_in_def by auto
with 1
have "dâ¼p" "dâ¼q" "dâ?UA"
using A_sub_upclosure[THEN subsetD] â¹AâPâº
leq_transD'[of A d a] leq_transD'[of A d b] by auto
then
show ?thesis unfolding compat_in_def by auto
qed
qed
lemma aux_RS1: "f â N â P â¹ nâN â¹ f`n â upclosure(f ``N)"
using elem_upclosure[OF subset_fun_image] image_fun
by (simp, blast)
lemma decr_succ_decr:
assumes "f â nat â P" "preorder_on(P,leq)"
"ânânat. â¨f ` succ(n), f ` nâ© â leq"
"mânat"
shows "nânat â¹ nâ¤m â¹ â¨f ` m, f ` nâ© â leq"
using â¹mâ_âº
proof(induct m)
case 0
then show ?case using assms refl_leq by simp
next
case (succ x)
then
have 1:"f`succ(x) â¼ f`x" "f`nâP" "f`xâP" "f`succ(x)âP"
using assms by simp_all
consider (lt) "n<succ(x)" | (eq) "n=succ(x)"
using succ le_succ_iff by auto
then
show ?case
proof(cases)
case lt
with 1 show ?thesis using leI succ leq_transD by auto
next
case eq
with 1 show ?thesis using refl_leq by simp
qed
qed
lemma decr_seq_linear:
assumes "refl(P,leq)" "f â nat â P"
"ânânat. â¨f ` succ(n), f ` nâ© â leq"
"trans[P](leq)"
shows "linear(f `` nat, leq)"
proof -
have "preorder_on(P,leq)"
unfolding preorder_on_def using assms by simp
{
fix n m
assume "nânat" "mânat"
then
have "f`m ⼠f`n ⨠f`n ⼠f`m"
proof(cases "mâ¤n")
case True
with â¹nâ_⺠â¹mâ_âº
show ?thesis
using decr_succ_decr[of f n m] assms leI â¹preorder_on(P,leq)⺠by simp
next
case False
with â¹nâ_⺠â¹mâ_âº
show ?thesis
using decr_succ_decr[of f m n] assms leI not_le_iff_lt â¹preorder_on(P,leq)⺠by simp
qed
}
then
show ?thesis
unfolding linear_def using ball_image_simp assms by auto
qed
end
subsectionâ¹Towards Rasiowa-Sikorski Lemma (RSL)âº
locale countable_generic = forcing_notion +
fixes ð
assumes countable_subs_of_P: "ð â natâPow(P)"
and seq_of_denses: "ân â nat. dense(ð`n)"
begin
definition
D_generic :: "iâo" where
"D_generic(G) â¡ filter(G) â§ (ânânat.(ð`n)â©Gâ 0)"
textâ¹The next lemma identifies a sufficient condition for obtaining
RSL.âº
lemma RS_sequence_imp_rasiowa_sikorski:
assumes
"pâP" "f : natâP" "f ` 0 = p"
"ân. nânat â¹ f ` succ(n)â¼ f ` n â§ f ` succ(n) â ð ` n"
shows
"âG. pâG â§ D_generic(G)"
proof -
note assms
moreover from this
have "f``nat â P"
by (simp add:subset_fun_image)
moreover from calculation
have "refl(f``nat, leq) â§ trans[P](leq)"
using leq_preord unfolding preorder_on_def by (blast intro:refl_monot_domain)
moreover from calculation
have "ânânat. f ` succ(n)â¼ f ` n" by (simp)
moreover from calculation
have "linear(f``nat, leq)"
using leq_preord and decr_seq_linear unfolding preorder_on_def by (blast)
moreover from calculation
have "(âpâf``nat.âqâf``nat. compat_in(f``nat,leq,p,q))"
using chain_compat by (auto)
ultimately
have "filter(upclosure(f``nat))" (is "filter(?G)")
using closure_compat_filter by simp
moreover
have "ânânat. ð ` n â© ?G â 0"
proof
fix n
assume "nânat"
with assms
have "f`succ(n) â ?G â§ f`succ(n) â ð ` n"
using aux_RS1 by simp
then
show "ð ` n â© ?G â 0" by blast
qed
moreover from assms
have "p â ?G"
using aux_RS1 by auto
ultimately
show ?thesis unfolding D_generic_def by auto
qed
end
textâ¹Now, the following recursive definition will fulfill the
requirements of lemma \<^term>â¹RS_sequence_imp_rasiowa_sikorski⺠âº
consts RS_seq :: "[i,i,i,i,i,i] â i"
primrec
"RS_seq(0,P,leq,p,enum,ð) = p"
"RS_seq(succ(n),P,leq,p,enum,ð) =
enum`(μ m. â¨enum`m, RS_seq(n,P,leq,p,enum,ð)â© â leq â§ enum`m â ð ` n)"
context countable_generic
begin
lemma countable_RS_sequence_aux:
fixes p enum
defines "f(n) â¡ RS_seq(n,P,leq,p,enum,ð)"
and "Q(q,k,m) â¡ enum`mâ¼ q â§ enum`m â ð ` k"
assumes "nânat" "pâP" "P â range(enum)" "enum:natâM"
"âx k. xâP â¹ kânat â¹ âqâP. qâ¼ x â§ q â ð ` k"
shows
"f(succ(n)) â P â§ f(succ(n))â¼ f(n) â§ f(succ(n)) â ð ` n"
using â¹nânatâº
proof (induct)
case 0
from assms
obtain q where "qâP" "qâ¼ p" "q â ð ` 0" by blast
moreover from this and â¹P â range(enum)âº
obtain m where "mânat" "enum`m = q"
using Pi_rangeD[OF â¹enum:natâMâº] by blast
moreover
have "ð`0 â P"
using apply_funtype[OF countable_subs_of_P] by simp
moreover note â¹pâPâº
ultimately
show ?case
using LeastI[of "Q(p,0)" m] unfolding Q_def f_def by auto
next
case (succ n)
with assms
obtain q where "qâP" "qâ¼ f(succ(n))" "q â ð ` succ(n)" by blast
moreover from this and â¹P â range(enum)âº
obtain m where "mânat" "enum`mâ¼ f(succ(n))" "enum`m â ð ` succ(n)"
using Pi_rangeD[OF â¹enum:natâMâº] by blast
moreover note succ
moreover from calculation
have "ð`succ(n) â P"
using apply_funtype[OF countable_subs_of_P] by auto
ultimately
show ?case
using LeastI[of "Q(f(succ(n)),succ(n))" m] unfolding Q_def f_def by auto
qed
lemma countable_RS_sequence:
fixes p enum
defines "f ⡠λnânat. RS_seq(n,P,leq,p,enum,ð)"
and "Q(q,k,m) â¡ enum`mâ¼ q â§ enum`m â ð ` k"
assumes "nânat" "pâP" "P â range(enum)" "enum:natâM"
shows
"f`0 = p" "f`succ(n)â¼ f`n â§ f`succ(n) â ð ` n" "f`succ(n) â P"
proof -
from assms
show "f`0 = p" by simp
{
fix x k
assume "xâP" "kânat"
then
have "âqâP. qâ¼ x â§ q â ð ` k"
using seq_of_denses apply_funtype[OF countable_subs_of_P]
unfolding dense_def by blast
}
with assms
show "f`succ(n)â¼ f`n â§ f`succ(n) â ð ` n" "f`succ(n)âP"
unfolding f_def using countable_RS_sequence_aux by simp_all
qed
lemma RS_seq_type:
assumes "n â nat" "pâP" "P â range(enum)" "enum:natâM"
shows "RS_seq(n,P,leq,p,enum,ð) â P"
using assms countable_RS_sequence(1,3)
by (induct;simp)
lemma RS_seq_funtype:
assumes "pâP" "P â range(enum)" "enum:natâM"
shows "(λnânat. RS_seq(n,P,leq,p,enum,ð)): nat â P"
using assms lam_type RS_seq_type by auto
lemmas countable_rasiowa_sikorski =
RS_sequence_imp_rasiowa_sikorski[OF _ RS_seq_funtype countable_RS_sequence(1,2)]
end
end
ad>
Theory Cohen_Posets_Relative
sectionâ¹Cohen forcing notionsâº
theory Cohen_Posets_Relative
imports
Forcing_Notions
Transitive_Models.Delta_System_Relative
Transitive_Models.Partial_Functions_Relative
begin
locale cohen_data =
fixes κ I J::i
assumes zero_lt_kappa: "0<κ"
begin
lemmas zero_lesspoll_kappa = zero_lesspoll[OF zero_lt_kappa]
end
locale add_reals = cohen_data nat _ 2
subsectionâ¹Combinatorial results on Cohen posetsâº
sublocale cohen_data â forcing_notion "Fn(κ,I,J)" "Fnle(κ,I,J)" 0
proof
show "0 â Fn(κ, I, J)"
using zero_lt_kappa zero_in_Fn by simp
then
show "âpâFn(κ, I, J). â¨p, 0â© â Fnle(κ, I, J)"
unfolding preorder_on_def refl_def trans_on_def
by auto
next
show "preorder_on(Fn(κ, I, J), Fnle(κ, I, J))"
unfolding preorder_on_def refl_def trans_on_def
by blast
qed
context cohen_data
begin
lemma compat_imp_Un_is_function:
assumes "G â Fn(κ, I, J)" "âp q. p â G â¹ q â G â¹ compat(p,q)"
shows "function(âG)"
unfolding function_def
proof (intro allI ballI impI)
fix x y y'
assume "â¨x, yâ© â âG" "â¨x, y'â© â âG"
then
obtain p q where "â¨x, yâ© â p" "â¨x, y'â© â q" "p â G" "q â G"
by auto
moreover from this and assms
obtain r where "r â Fn(κ, I, J)" "r â p" "r â q"
using compatD[of p q] by force
moreover from this
have "function(r)"
using Fn_is_function by simp
ultimately
show "y = y'"
unfolding function_def by fastforce
qed
lemma filter_subset_notion: "filter(G) â¹ G â Fn(κ, I, J)"
unfolding filter_def by simp
lemma Un_filter_is_function: "filter(G) â¹ function(âG)"
using compat_imp_Un_is_function filter_imp_compat[of G]
filter_subset_notion
by simp
end
locale M_cohen = M_delta +
assumes
countable_lepoll_assms2:
"M(A') â¹ M(A) â¹ M(b) â¹ M(f) â¹ separation(M, λy. âxâA'. y = â¨x, μ i. x â if_range_F_else_F(λa. {p â A . domain(p) = a}, b, f, i)â©)"
and
countable_lepoll_assms3:
"M(A) â¹ M(f) â¹ M(b) â¹ M(D) â¹ M(r') â¹ M(A')â¹
separation(M, λy. âxâA'. y = â¨x, μ i. x â if_range_F_else_F(drSR_Y(r', D, A), b, f, i)â©)"
context M_cardinal_library
begin
lemma lesspoll_nat_imp_lesspoll_rel:
assumes "A ⺠Ï" "M(A)"
shows "A âºâMâ Ï"
proof -
note assms
moreover from this
obtain f n where "fâbijâMâ(A,n)" "nâÏ" "A ââMâ n"
using lesspoll_nat_is_Finite Finite_rel_def[of M A]
by auto
moreover from calculation
have "A â²âMâ Ï"
using lesspoll_nat_is_Finite Infinite_imp_nats_lepoll_rel[of Ï n]
nat_not_Finite eq_lepoll_rel_trans[of A n Ï]
by auto
moreover from calculation
have "¬ g â bijâMâ(A,Ï)" for g
using mem_bij_rel unfolding lesspoll_def by auto
ultimately
show ?thesis
unfolding lesspoll_rel_def
by auto
qed
lemma Finite_imp_lesspoll_rel_nat:
assumes "Finite(A)" "M(A)"
shows "A âºâMâ Ï"
using Finite_imp_lesspoll_nat assms lesspoll_nat_imp_lesspoll_rel
by auto
lemma InfCard_rel_lesspoll_rel_Un:
includes Ord_dests
assumes "InfCard_rel(M,κ)" "A âºâMâ κ" "B âºâMâ κ"
and types: "M(κ)" "M(A)" "M(B)"
shows "A ⪠B âºâMâ κ"
proof -
from assms
have "|A|âMâ < κ" "|B|âMâ < κ"
using lesspoll_rel_cardinal_rel_lt InfCard_rel_is_Card_rel
by auto
show ?thesis
proof (cases "Finite(A) â§ Finite(B)")
case True
with assms
show ?thesis
using lesspoll_rel_trans2[OF _ le_imp_lepoll_rel, of _ nat κ]
Finite_imp_lesspoll_rel_nat[OF Finite_Un]
unfolding InfCard_rel_def
by simp
next
case False
with types
have "InfCard_rel(M,max(|A|âMâ,|B|âMâ))"
using Infinite_InfCard_rel_cardinal_rel InfCard_rel_is_Card_rel
le_trans[of nat] not_le_iff_lt[THEN iffD1, THEN leI, of "|A|âMâ" "|B|âMâ"]
unfolding max_def InfCard_rel_def
by auto
with â¹M(A)⺠â¹M(B)âº
have "|A ⪠B|âMâ ⤠max(|A|âMâ,|B|âMâ)"
using cardinal_rel_Un_le[of "max(|A|âMâ,|B|âMâ)" A B]
not_le_iff_lt[THEN iffD1, THEN leI, of "|A|âMâ" "|B|âMâ" ]
unfolding max_def
by simp
moreover from â¹|A|âMâ < κ⺠â¹|B|âMâ < κâº
have "max(|A|âMâ,|B|âMâ) < κ"
unfolding max_def
by simp
ultimately
have "|A ⪠B|âMâ < κ"
using lt_trans1
by blast
moreover
note â¹InfCard_rel(M,κ)âº
moreover from calculation types
have "|A ⪠B|âMâ âºâMâ κ"
using lt_Card_rel_imp_lesspoll_rel InfCard_rel_is_Card_rel
by simp
ultimately
show ?thesis
using cardinal_rel_eqpoll_rel eq_lesspoll_rel_trans[of "A ⪠B" "|A ⪠B|âMâ" κ]
eqpoll_rel_sym types
by simp
qed
qed
end
lemma (in M_cohen) Fn_rel_unionI:
assumes "p â FnâMâ(κ,I,J)" "qâFnâMâ(κ,I,J)" "InfCardâMâ(κ)"
"M(κ)" "M(I)" "M(J)" "domain(p) ⩠domain(q) = 0"
shows "pâªq â FnâMâ(κ,I,J)"
proof -
note assms
moreover from calculation
have "p âºâMâ κ" "q âºâMâ κ" "M(p)" "M(q)"
using Fn_rel_is_function by simp_all
moreover from calculation
have "pâªq âºâMâ κ"
using eqpoll_rel_sym cardinal_rel_eqpoll_rel InfCard_rel_lesspoll_rel_Un
by simp_all
ultimately
show ?thesis
unfolding Fn_rel_def
using pfun_unionI cardinal_rel_eqpoll_rel eq_lesspoll_rel_trans[OF _ â¹pâªq âºâMâ _âº]
by auto
qed
lemma (in M_cohen) restrict_eq_imp_compat_rel:
assumes "p â FnâMâ(κ, I, J)" "q â FnâMâ(κ, I, J)" "InfCardâMâ(κ)" "M(J)" "M(κ)"
"restrict(p, domain(p) â© domain(q)) = restrict(q, domain(p) â© domain(q))"
shows "p ⪠q â FnâMâ(κ, I, J)"
proof -
note assms
moreover from calculation
have "p âºâMâ κ" "q âºâMâ κ" "M(p)" "M(q)"
using Fn_rel_is_function by simp_all
moreover from calculation
have "pâªq âºâMâ κ"
using InfCard_rel_lesspoll_rel_Un cardinal_rel_eqpoll_rel[THEN eqpoll_rel_sym]
by auto
ultimately
show ?thesis
unfolding Fn_rel_def
using pfun_restrict_eq_imp_compat cardinal_rel_eqpoll_rel
eq_lesspoll_rel_trans[OF _ â¹pâªq âºâMâ _âº]
by auto
qed
lemma (in M_cohen) InfCard_rel_imp_n_lesspoll_rel :
assumes "InfCardâMâ(κ)" "M(κ)" "nâÏ"
shows "n âºâMâ κ"
proof -
note assms
moreover from this
have "n âºâMâ Ï"
using n_lesspoll_rel_nat by simp
ultimately
show ?thesis
using lesspoll_rel_trans2 Infinite_iff_lepoll_rel_nat InfCard_rel_imp_Infinite nat_into_M
by simp
qed
lemma (in M_cohen) cons_in_Fn_rel:
assumes "x â domain(p)" "p â FnâMâ(κ,I,J)" "x â I" "j â J" "InfCardâMâ(κ)"
"M(κ)" "M(I)" "M(J)"
shows "cons(â¨x,jâ©, p) â FnâMâ(κ,I,J)"
using assms cons_eq Fn_rel_unionI[OF Fn_rel_singletonI[of x I j J] â¹pâ_âº]
InfCard_rel_imp_n_lesspoll_rel
by auto
lemma (in M_library) Fnle_rel_Aleph_rel1_closed[intro,simp]:
"M(FnleâMâ(âµâ1ââMâ, âµâ1ââMâ, Ï ââMâ 2))"
by simp
locale M_add_reals = M_cohen + add_reals
begin
lemmas zero_lesspoll_rel_kappa = zero_lesspoll_rel[OF zero_lt_kappa]
end
relativize relational "compat_in" "is_compat_in" external
synthesize "compat_in" from_definition "is_compat_in" assuming "nonempty"
context
notes Un_assoc[simp] Un_trasposition_aux2[simp]
begin
arity_theorem for "compat_in_fm"
end
lemma (in M_trivial) compat_in_abs[absolut]:
assumes
"M(A)" "M(r)" "M(p)" "M(q)"
shows
"is_compat_in(M,A,r,p,q) â· compat_in(A,r,p,q)"
using assms unfolding is_compat_in_def compat_in_def by simp
definition
antichain :: "iâiâiâo" where
"antichain(P,leq,A) â¡ AâP â§ (âpâA. âqâA. pâ q ⶠ¬compat_in(P,leq,p,q))"
relativize relational "antichain" "antichain_rel"
definition
ccc :: "i â i â o" where
"ccc(P,leq) â¡ âA. antichain(P,leq,A) â¶ |A| ⤠nat"
abbreviation
antichain_rel_abbr :: "[iâo,i,i,i] â o" (â¹antichainâ_â'(_,_,_')âº) where
"antichainâMâ(P,leq,A) â¡ antichain_rel(M,P,leq,A)"
abbreviation
antichain_r_set :: "[i,i,i,i] â o" (â¹antichainâ_â'(_,_,_')âº) where
"antichainâMâ(P,leq,A) â¡ antichain_rel(##M,P,leq,A)"
context M_trivial
begin
lemma antichain_abs [absolut]:
"⦠M(A); M(P); M(leq) â§ â¹ antichainâMâ(P,leq,A) â· antichain(P,leq,A)"
unfolding antichain_rel_def antichain_def by (simp add:absolut)
end
relativize relational "ccc" "ccc_rel"
abbreviation
ccc_rel_abbr :: "[iâo,i,i]âo" (â¹cccâ_â'(_,_')âº) where
"ccc_rel_abbr(M) â¡ ccc_rel(M)"
abbreviation
ccc_r_set :: "[i,i,i]âo" (â¹cccâ_â'(_,_')âº) where
"ccc_r_set(M) â¡ ccc_rel(##M)"
context M_cardinals
begin
lemma def_ccc_rel:
shows
"cccâMâ(P,leq) â· (âA[M]. antichainâMâ(P,leq,A) â¶ |A|âMâ ⤠Ï)"
using is_cardinal_iff
unfolding ccc_rel_def by (simp add:absolut)
end
context M_FiniteFun
begin
lemma Fnle_nat_closed[intro,simp]:
assumes "M(I)" "M(J)"
shows "M(Fnle(Ï,I,J))"
unfolding Fnle_def Fnlerel_def Rrel_def
using supset_separation FiniteFun_closed Fn_nat_eq_FiniteFun assms by simp
lemma Fn_nat_closed:
assumes "M(A)" "M(B)" shows "M(Fn(Ï,A,B))"
using assms Fn_nat_eq_FiniteFun
by simp
end
context M_add_reals
begin
lemma lam_replacement_drSR_Y: "M(A) â¹ M(D) â¹ M(r') â¹ lam_replacement(M, drSR_Y(r',D,A))"
using lam_replacement_drSR_Y
by simp
lemma (in M_trans) mem_F_bound3:
fixes F A
defines "F â¡ dC_F"
shows "xâF(A,c) â¹ c â (range(f) ⪠{domain(x). xâA})"
using apply_0 unfolding F_def
by (cases "M(c)", auto simp:F_def drSR_Y_def dC_F_def)
lemma ccc_rel_Fn_nat:
assumes "M(I)"
shows "cccâMâ(Fn(nat,I,2), Fnle(nat,I,2))"
proof -
have repFun_dom_closed:"M({domain(p) . p â A})" if "M(A)" for A
using RepFun_closed domain_replacement_simp transM[OF _ â¹M(A)âº] that
by auto
from assms
have "M(Fn(nat,I,2))" using Fn_nat_eq_FiniteFun by simp
{
fix A
assume "¬ |A|âMâ ⤠nat" "M(A)" "A â Fn(nat, I, 2)"
moreover from this
have "countable_rel(M,{pâA. domain(p) = d})" if "M(d)" for d
proof (cases "dâºâMânat â§ d â I")
case True
with â¹A â Fn(nat, I, 2)⺠â¹M(A)âº
have "{p â A . domain(p) = d} â d ââMâ 2"
using domain_of_fun function_space_rel_char[of _ 2]
by (auto,subgoal_tac "M(domain(x))",simp_all add:transM[of _ A],force)
moreover from True â¹M(d)âº
have "Finite(d ââMâ 2)"
using Finite_Pi[THEN [2] subset_Finite, of _ d "λ_. 2"]
lesspoll_rel_nat_is_Finite_rel function_space_rel_char[of _ 2]
by auto
moreover from â¹M(d)âº
have "M(d ââMâ 2)"
by simp
moreover from â¹M(A)âº
have "M({p â A . domain(p) = d})"
using separation_closed domain_eq_separation[OF â¹M(d)âº] by simp
ultimately
show ?thesis using subset_Finite[of _ "dââMâ2" ]
by (auto intro!:Finite_imp_countable_rel)
next
case False
with â¹A â Fn(nat, I, 2)⺠â¹M(A)âº
have "domain(p) â d" if "pâA" for p
proof -
note False that â¹M(A)âº
moreover from this
obtain d' where "d' â I" "pâd' â 2" "d' ⺠Ï"
using FnD[OF subsetD[OF â¹Aâ_⺠â¹pâAâº]]
by auto
moreover from this
have "p â d'" "domain(p) = d'"
using function_eqpoll Pi_iff
by auto
ultimately
show ?thesis
using lesspoll_nat_imp_lesspoll_rel transM[of p]
by auto
qed
then
show ?thesis
using empty_lepoll_relI by auto
qed
have 2:"M(x) â¹ x â dC_F(X, i) â¹ M(i)" for x X i
unfolding dC_F_def
by auto
moreover
have "uncountable_rel(M,{domain(p) . p â A})"
proof
interpret M_replacement_lepoll M dC_F
using lam_replacement_dC_F domain_eq_separation lam_replacement_inj_rel
unfolding dC_F_def
proof(unfold_locales,simp_all)
fix X b f
assume "M(X)" "M(b)" "M(f)"
with 2[of X]
show "lam_replacement(M, λx. μ i. x â if_range_F_else_F(λd. {p â X . domain(p) = d}, b, f, i))"
using lam_replacement_dC_F domain_eq_separation
mem_F_bound3 countable_lepoll_assms2 repFun_dom_closed
by (rule_tac lam_Least_assumption_general[where U="λ_. {domain(x). xâX}"],auto)
qed (auto)
have "âaâA. x = domain(a) â¹ M(dC_F(A,x))" for x
using â¹M(A)⺠transM[OF _ â¹M(A)âº] by (auto)
moreover
have "w â A â§ domain(w) = x â¹ M(x)" for w x
using transM[OF _ â¹M(A)âº] by auto
ultimately
interpret M_cardinal_UN_lepoll _ "dC_F(A)" "{domain(p). pâA}"
using lam_replacement_dC_F lam_replacement_inj_rel â¹M(A)âº
lepoll_assumptions domain_eq_separation
countable_lepoll_assms2 repFun_dom_closed
lepoll_assumptions1[OF â¹M(A)⺠repFun_dom_closed[OF â¹M(A)âº]]
apply(unfold_locales)
by(simp_all del:if_range_F_else_F_def,
rule_tac lam_Least_assumption_general[where U="λ_. {domain(x). xâA}"])
(auto simp del:if_range_F_else_F_def simp add:dC_F_def)
from â¹A â Fn(nat, I, 2)âº
have x:"(âdâ{domain(p) . p â A}. {pâA. domain(p) = d}) = A"
by auto
moreover
assume "countable_rel(M,{domain(p) . p â A})"
moreover
note â¹âd. M(d) â¹ countable_rel(M,{pâA. domain(p) = d})âº
moreover from â¹M(A)âº
have "pâA â¹ M(domain(p))" for p
by (auto dest: transM)
ultimately
have "countable_rel(M,A)"
using countable_rel_imp_countable_rel_UN
unfolding dC_F_def
by auto
with â¹Â¬ |A|âMâ ⤠nat⺠â¹M(A)âº
show False
using countable_rel_iff_cardinal_rel_le_nat by simp
qed
moreover from â¹A â Fn(nat, I, 2)⺠â¹M(A)âº
have "p â A â¹ Finite(domain(p))" for p
using lesspoll_rel_nat_is_Finite_rel[of "domain(p)"]
lesspoll_nat_imp_lesspoll_rel[of "domain(p)"]
domain_of_fun[of p _ "λ_. 2"] by (auto dest:transM)
moreover
note repFun_dom_closed[OF â¹M(A)âº]
ultimately
obtain D where "delta_system(D)" "D â {domain(p) . p â A}" "D ââMâ âµâ1ââMâ" "M(D)"
using delta_system_uncountable_rel[of "{domain(p) . p â A}"] by auto
then
have delta:"âd1âD. âd2âD. d1 â d2 â¶ d1 â© d2 = âD"
using delta_system_root_eq_Inter
by simp
moreover from â¹D ââMâ âµâ1ââMâ⺠â¹M(D)âº
have "uncountable_rel(M,D)"
using uncountable_rel_iff_subset_eqpoll_rel_Aleph_rel1 by auto
moreover from this and â¹D â {domain(p) . p â A}âº
obtain p1 where "p1 â A" "domain(p1) â D"
using uncountable_rel_not_empty[of D] by blast
moreover from this and â¹p1 â A â¹ Finite(domain(p1))âº
have "Finite(domain(p1))"
using Finite_domain by simp
moreover
define r where "r â¡ âD"
moreover from â¹M(D)âº
have "M(r)" "M(rÃ2)"
unfolding r_def by simp_all
ultimately
have "Finite(r)" using subset_Finite[of "r" "domain(p1)"]
by auto
have "countable_rel(M,{restrict(p,r) . pâA})"
proof -
note â¹M(Fn(nat, I, 2))⺠â¹M(r)âº
moreover from this
have "fâFn(nat, I, 2) â¹ M(restrict(f,r))" for f
by (blast dest: transM)
ultimately
have "fâFn(nat, I, 2) â¹ restrict(f,r) â Pow_rel(M,r à 2)" for f
using restrict_subset_Sigma[of f _ "λ_. 2" r] Pow_rel_char
by (auto del:FnD dest!:FnD simp: Pi_def) (auto dest:transM)
with â¹A â Fn(nat, I, 2)âº
have "{restrict(f,r) . f â A } â Pow_rel(M,r à 2)"
by fast
moreover from â¹M(A)⺠â¹M(r)âº
have "M({restrict(f,r) . f â A })"
using RepFun_closed restrict_strong_replacement transM[OF _ â¹M(A)âº] by auto
moreover
note â¹Finite(r)⺠â¹M(r)âº
ultimately
show ?thesis
using Finite_Sigma[THEN Finite_Pow_rel, of r "λ_. 2"]
by (intro Finite_imp_countable_rel) (auto intro:subset_Finite)
qed
moreover from â¹M(A)⺠â¹M(D)âº
have "M({pâA. domain(p) â D})"
using domain_mem_separation by simp
have "uncountable_rel(M,{pâA. domain(p) â D})" (is "uncountable_rel(M,?X)")
proof
from â¹D â {domain(p) . p â A}âº
have "(λpâ?X. domain(p)) â surj(?X, D)"
using lam_type unfolding surj_def by auto
moreover from â¹M(A)⺠â¹M(?X)âº
have "M(λpâ?X. domain(p))"
using lam_closed[OF domain_replacement â¹M(?X)âº] transM[OF _ â¹M(?X)âº] by simp
moreover
note â¹M(?X)⺠â¹M(D)âº
moreover from calculation
have surjection:"(λpâ?X. domain(p)) â surjâMâ(?X, D)"
using surj_rel_char by simp
moreover
assume "countable_rel(M,?X)"
moreover
note â¹uncountable_rel(M,D)âº
ultimately
show False
using surj_rel_countable_rel[OF _ surjection] by auto
qed
moreover
have "D = (âfâPow_rel(M,rÃ2) . {y . pâA, restrict(p,r) = f â§ y=domain(p) â§ domain(p) â D})"
proof -
{
fix z
assume "z â D"
with â¹M(D)âº
have â¹M(z)⺠by (auto dest:transM)
from â¹zâD⺠â¹D â _⺠â¹M(A)âº
obtain p where "domain(p) = z" "p â A" "M(p)"
by (auto dest:transM)
moreover from â¹A â Fn(nat, I, 2)⺠â¹M(z)⺠and this
have "p â z ââMâ 2"
using domain_of_fun function_space_rel_char by (auto del:FnD dest!:FnD)
moreover from this â¹M(z)âº
have "p â z â 2"
using domain_of_fun function_space_rel_char by (auto)
moreover from this â¹M(r)âº
have "restrict(p,r) â r à 2"
using function_restrictI[of p r] fun_is_function[of p z "λ_. 2"]
restrict_subset_Sigma[of p z "λ_. 2" r] function_space_rel_char
by (auto simp:Pi_def)
moreover from â¹M(p)⺠â¹M(r)âº
have "M(restrict(p,r))" by simp
moreover
note â¹M(r)âº
ultimately
have "âpâA. restrict(p,r) â Pow_rel(M,rÃ2) â§ domain(p) = z"
using Pow_rel_char by auto
}
then
show ?thesis
by (intro equalityI) (force)+
qed
from â¹M(D)âºâ¹M(r)âº
have "M({y . pâA, restrict(p,r) = f â§ y=domain(p) â§ domain(p) â D})" (is "M(?Y(A,f))")
if "M(f)" "M(A)" for f A
using drSR_Y_closed[unfolded drSR_Y_def] that
by simp
then
obtain f where "uncountable_rel(M,?Y(A,f))" "M(f)"
proof -
have 1:"M(i)"
if "M(B)" "M(x)"
"x â {y . x â B, restrict(x, r) = i â§ y = domain(x) â§ domain(x) â D}"
for B x i
using that â¹M(r)âº
by (auto dest:transM)
note â¹M(r)âº
moreover from this
have "M(PowâMâ(r à 2))" by simp
moreover
note â¹M(A)⺠â¹âf A. M(f) â¹ M(A) â¹ M(?Y(A,f))⺠â¹M(D)âº
moreover from calculation
interpret M_replacement_lepoll M "drSR_Y(r,D)"
using countable_lepoll_assms3 lam_replacement_inj_rel lam_replacement_drSR_Y
drSR_Y_closed lam_Least_assumption_drSR_Y
by (unfold_locales,simp_all add:drSR_Y_def,rule_tac 1,simp_all)
from calculation
have "x â PowâMâ(r à 2) â¹ M(drSR_Y(r, D, A, x))" for x
unfolding drSR_Y_def by (auto dest:transM)
ultimately
interpret M_cardinal_UN_lepoll _ "?Y(A)" "Pow_rel(M,rÃ2)"
using countable_lepoll_assms3 lam_replacement_drSR_Y
lepoll_assumptions[where S="Pow_rel(M,rÃ2)", unfolded lepoll_assumptions_defs]
lam_Least_assumption_drSR_Y[unfolded drSR_Y_def]
unfolding drSR_Y_def
apply unfold_locales
apply (simp_all add:lam_replacement_inj_rel del: if_range_F_else_F_def,rule_tac 1,simp_all)
by ((fastforce dest:transM[OF _ â¹M(A)âº])+)
{
from â¹Finite(r)⺠â¹M(r)âº
have "countable_rel(M,Pow_rel(M,rÃ2))"
using Finite_Sigma[THEN Finite_Pow_rel] Finite_imp_countable_rel
by simp
moreover
assume "M(f) â¹ countable_rel(M,?Y(A,f))" for f
moreover
note â¹D = (âfâPow_rel(M,rÃ2) .?Y(A,f))⺠â¹M(r)âº
moreover
note â¹uncountable_rel(M,D)âº
ultimately
have "False"
using countable_rel_imp_countable_rel_UN by (auto dest: transM)
}
with that
show ?thesis
by auto
qed
moreover from this â¹M(A)⺠and â¹M(f) â¹ M(A) â¹ M(?Y(A,f))âº
have "M(?Y(A,f))"
by blast
ultimately
obtain j where "j â inj_rel(M,nat, ?Y(A,f))" "M(j)"
using uncountable_rel_iff_nat_lt_cardinal_rel[THEN iffD1, THEN leI,
THEN cardinal_rel_le_imp_lepoll_rel, THEN lepoll_relD]
by auto
with â¹M(?Y(A,f))âº
have "j`0 â j`1" "j`0 â ?Y(A,f)" "j`1 â ?Y(A,f)"
using inj_is_fun[THEN apply_type, of j nat "?Y(A,f)"]
inj_rel_char
unfolding inj_def by auto
then
obtain p q where "domain(p) â domain(q)" "p â A" "q â A"
"domain(p) â D" "domain(q) â D"
"restrict(p,r) = restrict(q,r)" by auto
moreover from this and delta
have "domain(p) â© domain(q) = r"
unfolding r_def by simp
moreover
note â¹A â Fn(nat, I, 2)⺠Fn_nat_abs[OF â¹M(I)⺠nat_into_M[of 2],simplified]
moreover from calculation
have "p â FnâMâ(nat, I, 2)" "q â FnâMâ(nat, I, 2)"
by auto
moreover from calculation
have "p ⪠q â Fn(nat, I, 2)"
using restrict_eq_imp_compat_rel InfCard_rel_nat
by simp
ultimately
have "âpâA. âqâA. p â q â§ compat_in(Fn(nat, I, 2), Fnle(nat, I, 2), p, q)"
unfolding compat_in_def
by (rule_tac bexI[of _ p], rule_tac bexI[of _ q]) blast
}
moreover from assms
have "M(Fnle(Ï,I,2))"
by simp
moreover note â¹M(Fn(Ï,I,2))âº
ultimately
show ?thesis using def_ccc_rel by (auto simp:absolut antichain_def) fastforce
qed
end
endv class="head">
Theory Edrel
theory Edrel
imports
Transitive_Models.ZF_Miscellanea
Transitive_Models.Recursion_Thms
begin
subsectionâ¹The well-founded relation \<^term>â¹edâºâº
lemma eclose_sing : "x â eclose(a) â¹ x â eclose({a})"
using subsetD[OF mem_eclose_subset]
by simp
lemma ecloseE :
assumes "x â eclose(A)"
shows "x â A ⨠(â B â A . x â eclose(B))"
using assms
proof (induct rule:eclose_induct_down)
case (1 y)
then
show ?case
using arg_into_eclose by auto
next
case (2 y z)
from â¹y â A ⨠(âBâA. y â eclose(B))âº
consider (inA) "y â A" | (exB) "(âBâA. y â eclose(B))"
by auto
then show ?case
proof (cases)
case inA
then
show ?thesis using 2 arg_into_eclose by auto
next
case exB
then obtain B where "y â eclose(B)" "BâA"
by auto
then
show ?thesis using 2 ecloseD[of y B z] by auto
qed
qed
lemma eclose_singE : "x â eclose({a}) â¹ x = a ⨠x â eclose(a)"
by(blast dest: ecloseE)
lemma in_eclose_sing :
assumes "x â eclose({a})" "a â eclose(z)"
shows "x â eclose({z})"
proof -
from â¹xâeclose({a})âº
consider "x=a" | "xâeclose(a)"
using eclose_singE by auto
then
show ?thesis
using eclose_sing mem_eclose_trans assms
by (cases, auto)
qed
lemma in_dom_in_eclose :
assumes "x â domain(z)"
shows "x â eclose(z)"
proof -
from assms
obtain y where "â¨x,yâ© â z"
unfolding domain_def by auto
then
show ?thesis
unfolding Pair_def
using ecloseD[of "{x,x}"] ecloseD[of "{{x,x},{x,y}}"] arg_into_eclose
by auto
qed
textâ¹termâ¹ed⺠is the well-founded relation on which \<^term>â¹val⺠is defined.âº
definition
ed :: "[i,i] â o" where
"ed(x,y) â¡ x â domain(y)"
definition
edrel :: "i â i" where
"edrel(A) â¡ Rrel(ed,A)"
lemma edI[intro!]: "tâdomain(x) â¹ ed(t,x)"
unfolding ed_def .
lemma edD[dest!]: "ed(t,x) â¹ tâdomain(x)"
unfolding ed_def .
lemma rank_ed:
assumes "ed(y,x)"
shows "succ(rank(y)) ⤠rank(x)"
proof
from assms
obtain p where "â¨y,pâ©âx" by auto
moreover
obtain s where "yâs" "sââ¨y,pâ©" unfolding Pair_def by auto
ultimately
have "rank(y) < rank(s)" "rank(s) < rank(â¨y,pâ©)" "rank(â¨y,pâ©) < rank(x)"
using rank_lt by blast+
then
show "rank(y) < rank(x)"
using lt_trans by blast
qed
lemma edrel_dest [dest]: "x â edrel(A) â¹ â aâ A. â b â A. x =â¨a,bâ©"
by(auto simp add:ed_def edrel_def Rrel_def)
lemma edrelD : "x â edrel(A) â¹ â aâ A. â b â A. x =â¨a,bâ© â§ a â domain(b)"
by(auto simp add:ed_def edrel_def Rrel_def)
lemma edrelI [intro!]: "xâA â¹ yâA â¹ x â domain(y) â¹ â¨x,yâ©âedrel(A)"
by (simp add:ed_def edrel_def Rrel_def)
lemma edrel_trans: "Transset(A) â¹ yâA â¹ x â domain(y) â¹ â¨x,yâ©âedrel(A)"
by (rule edrelI, auto simp add:Transset_def domain_def Pair_def)
lemma domain_trans: "Transset(A) â¹ yâA â¹ x â domain(y) â¹ xâA"
by (auto simp add: Transset_def domain_def Pair_def)
lemma relation_edrel : "relation(edrel(A))"
by(auto simp add: relation_def)
lemma field_edrel : "field(edrel(A))âA"
by blast
lemma edrel_sub_memrel: "edrel(A) â trancl(Memrel(eclose(A)))"
proof
let
?r="trancl(Memrel(eclose(A)))"
fix z
assume "zâedrel(A)"
then
obtain x y where "xâA" "yâA" "z=â¨x,yâ©" "xâdomain(y)"
using edrelD
by blast
moreover from this
obtain u v where "xâu" "uâv" "vây"
unfolding domain_def Pair_def by auto
moreover from calculation
have "xâeclose(A)" "yâeclose(A)" "yâeclose(A)"
using arg_into_eclose Transset_eclose[unfolded Transset_def]
by simp_all
moreover from calculation
have "vâeclose(A)"
by auto
moreover from calculation
have "uâeclose(A)"
using Transset_eclose[unfolded Transset_def]
by auto
moreover from calculation
have"â¨x,uâ©â?r" "â¨u,vâ©â?r" "â¨v,yâ©â?r"
by (auto simp add: r_into_trancl)
moreover from this
have "â¨x,yâ©â?r"
using trancl_trans[OF _ trancl_trans[of _ v _ y]]
by simp
ultimately
show "zâ?r"
by simp
qed
lemma wf_edrel : "wf(edrel(A))"
using wf_subset [of "trancl(Memrel(eclose(A)))"] edrel_sub_memrel
wf_trancl wf_Memrel
by auto
lemma ed_induction:
assumes "âx. â¦ây. ed(y,x) â¹ Q(y) â§ â¹ Q(x)"
shows "Q(a)"
proof(induct rule: wf_induct2[OF wf_edrel[of "eclose({a})"] ,of a "eclose({a})"])
case 1
then show ?case using arg_into_eclose by simp
next
case 2
then show ?case using field_edrel .
next
case (3 x)
then
show ?case
using assms[of x] edrelI domain_trans[OF Transset_eclose 3(1)] by blast
qed
lemma dom_under_edrel_eclose: "edrel(eclose({x})) -`` {x} = domain(x)"
proof(intro equalityI)
show "edrel(eclose({x})) -`` {x} â domain(x)"
unfolding edrel_def Rrel_def ed_def
by auto
next
show "domain(x) â edrel(eclose({x})) -`` {x}"
unfolding edrel_def Rrel_def
using in_dom_in_eclose eclose_sing arg_into_eclose
by blast
qed
lemma ed_eclose : "â¨y,zâ© â edrel(A) â¹ y â eclose(z)"
by(drule edrelD,auto simp add:domain_def in_dom_in_eclose)
lemma tr_edrel_eclose : "â¨y,zâ© â edrel(eclose({x}))^+ â¹ y â eclose(z)"
by(rule trancl_induct,(simp add: ed_eclose mem_eclose_trans)+)
lemma restrict_edrel_eq :
assumes "z â domain(x)"
shows "edrel(eclose({x})) â© eclose({z})Ãeclose({z}) = edrel(eclose({z}))"
proof(intro equalityI subsetI)
let ?ec="λ y . edrel(eclose({y}))"
let ?ez="eclose({z})"
let ?rr="?ec(x) ⩠?ez à ?ez"
fix y
assume "y â ?rr"
then
obtain a b where "â¨a,bâ© â ?rr" "a â ?ez" "b â ?ez" "â¨a,bâ© â ?ec(x)" "y=â¨a,bâ©"
by blast
moreover from this
have "a â domain(b)"
using edrelD by blast
ultimately
show "y â edrel(eclose({z}))"
by blast
next
let ?ec="λ y . edrel(eclose({y}))"
let ?ez="eclose({z})"
let ?rr="?ec(x) ⩠?ez à ?ez"
fix y
assume "y â edrel(?ez)"
then
obtain a b where "a â ?ez" "b â ?ez" "y=â¨a,bâ©" "a â domain(b)"
using edrelD by blast
moreover
from this assms
have "z â eclose(x)"
using in_dom_in_eclose by simp
moreover
from assms calculation
have "a â eclose({x})" "b â eclose({x})"
using in_eclose_sing by simp_all
moreover from calculation
have "â¨a,bâ© â edrel(eclose({x}))"
by blast
ultimately
show "y â ?rr"
by simp
qed
lemma tr_edrel_subset :
assumes "z â domain(x)"
shows "tr_down(edrel(eclose({x})),z) â eclose({z})"
proof(intro subsetI)
let ?r="λ x . edrel(eclose({x}))"
fix y
assume "y â tr_down(?r(x),z)"
then
have "â¨y,zâ© â ?r(x)^+"
using tr_downD by simp
with assms
show "y â eclose({z})"
using tr_edrel_eclose eclose_sing by simp
qed
end v class="head">
Theory FrecR
sectionâ¹Well-founded relation on namesâº
theory FrecR
imports
Transitive_Models.Discipline_Function
Edrel
begin
textâ¹\<^term>â¹frecR⺠is the well-founded relation on names that allows
us to define forcing for atomic formulas.âº
definition
ftype :: "iâi" where
"ftype â¡ fst"
definition
name1 :: "iâi" where
"name1(x) â¡ fst(snd(x))"
definition
name2 :: "iâi" where
"name2(x) â¡ fst(snd(snd(x)))"
definition
cond_of :: "iâi" where
"cond_of(x) â¡ snd(snd(snd((x))))"
lemma components_simp:
"ftype(â¨f,n1,n2,câ©) = f"
"name1(â¨f,n1,n2,câ©) = n1"
"name2(â¨f,n1,n2,câ©) = n2"
"cond_of(â¨f,n1,n2,câ©) = c"
unfolding ftype_def name1_def name2_def cond_of_def
by simp_all
definition eclose_n :: "[iâi,i] â i" where
"eclose_n(name,x) = eclose({name(x)})"
definition
ecloseN :: "i â i" where
"ecloseN(x) = eclose_n(name1,x) ⪠eclose_n(name2,x)"
lemma components_in_eclose :
"n1 â ecloseN(â¨f,n1,n2,câ©)"
"n2 â ecloseN(â¨f,n1,n2,câ©)"
unfolding ecloseN_def eclose_n_def
using components_simp arg_into_eclose by auto
lemmas names_simp = components_simp(2) components_simp(3)
lemma ecloseNI1 :
assumes "x â eclose(n1) ⨠xâeclose(n2)"
shows "x â ecloseN(â¨f,n1,n2,câ©)"
unfolding ecloseN_def eclose_n_def
using assms eclose_sing names_simp
by auto
lemmas ecloseNI = ecloseNI1
lemma ecloseN_mono :
assumes "u â ecloseN(x)" "name1(x) â ecloseN(y)" "name2(x) â ecloseN(y)"
shows "u â ecloseN(y)"
proof -
from â¹uâ_âº
consider (a) "uâeclose({name1(x)})" | (b) "u â eclose({name2(x)})"
unfolding ecloseN_def eclose_n_def by auto
then
show ?thesis
proof cases
case a
with â¹name1(x) â _âº
show ?thesis
unfolding ecloseN_def eclose_n_def
using eclose_singE[OF a] mem_eclose_trans[of u "name1(x)" ] by auto
next
case b
with â¹name2(x) â _âº
show ?thesis
unfolding ecloseN_def eclose_n_def
using eclose_singE[OF b] mem_eclose_trans[of u "name2(x)"] by auto
qed
qed
definition
is_ftype :: "(iâo)âiâiâo" where
"is_ftype â¡ is_fst"
definition
ftype_fm :: "[i,i] â i" where
"ftype_fm â¡ fst_fm"
lemma is_ftype_iff_sats [iff_sats]:
assumes
"nth(a,env) = x" "nth(b,env) = y" "aânat" "bânat" "env â list(A)"
shows
"is_ftype(##A,x,y) â· sats(A,ftype_fm(a,b), env)"
unfolding ftype_fm_def is_ftype_def
using assms sats_fst_fm
by simp
definition
is_name1 :: "(iâo)âiâiâo" where
"is_name1(M,x,t2) â¡ is_hcomp(M,is_fst(M),is_snd(M),x,t2)"
definition
name1_fm :: "[i,i] â i" where
"name1_fm(x,t) â¡ hcomp_fm(fst_fm,snd_fm,x,t)"
lemma sats_name1_fm [simp]:
"⦠x â nat; y â nat;env â list(A) â§ â¹
(A, env ⨠name1_fm(x,y)) ⷠis_name1(##A, nth(x,env), nth(y,env))"
unfolding name1_fm_def is_name1_def
using sats_fst_fm sats_snd_fm sats_hcomp_fm[of A "is_fst(##A)" _ fst_fm "is_snd(##A)"]
by simp
lemma is_name1_iff_sats [iff_sats]:
assumes
"nth(a,env) = x" "nth(b,env) = y" "aânat" "bânat" "env â list(A)"
shows
"is_name1(##A,x,y) ⷠA , env ⨠name1_fm(a,b)"
using assms sats_name1_fm
by simp
definition
is_snd_snd :: "(iâo)âiâiâo" where
"is_snd_snd(M,x,t) â¡ is_hcomp(M,is_snd(M),is_snd(M),x,t)"
definition
snd_snd_fm :: "[i,i]âi" where
"snd_snd_fm(x,t) â¡ hcomp_fm(snd_fm,snd_fm,x,t)"
lemma sats_snd2_fm [simp]:
"⦠x â nat; y â nat;env â list(A) â§ â¹
(A, env ⨠snd_snd_fm(x,y)) ⷠis_snd_snd(##A, nth(x,env), nth(y,env))"
unfolding snd_snd_fm_def is_snd_snd_def
using sats_snd_fm sats_hcomp_fm[of A "is_snd(##A)" _ snd_fm "is_snd(##A)"]
by simp
definition
is_name2 :: "(iâo)âiâiâo" where
"is_name2(M,x,t3) â¡ is_hcomp(M,is_fst(M),is_snd_snd(M),x,t3)"
definition
name2_fm :: "[i,i] â i" where
"name2_fm(x,t3) â¡ hcomp_fm(fst_fm,snd_snd_fm,x,t3)"
lemma sats_name2_fm :
"⦠x â nat; y â nat;env â list(A) â§
⹠(A , env ⨠name2_fm(x,y)) ⷠis_name2(##A, nth(x,env), nth(y,env))"
unfolding name2_fm_def is_name2_def
using sats_fst_fm sats_snd2_fm sats_hcomp_fm[of A "is_fst(##A)" _ fst_fm "is_snd_snd(##A)"]
by simp
lemma is_name2_iff_sats [iff_sats]:
assumes
"nth(a,env) = x" "nth(b,env) = y" "aânat" "bânat" "env â list(A)"
shows
"is_name2(##A,x,y) ⷠA, env ⨠name2_fm(a,b)"
using assms sats_name2_fm
by simp
definition
is_cond_of :: "(iâo)âiâiâo" where
"is_cond_of(M,x,t4) â¡ is_hcomp(M,is_snd(M),is_snd_snd(M),x,t4)"
definition
cond_of_fm :: "[i,i] â i" where
"cond_of_fm(x,t4) â¡ hcomp_fm(snd_fm,snd_snd_fm,x,t4)"
lemma sats_cond_of_fm :
"⦠x â nat; y â nat;env â list(A) â§ â¹
(A, env ⨠cond_of_fm(x,y)) ⷠis_cond_of(##A, nth(x,env), nth(y,env))"
unfolding cond_of_fm_def is_cond_of_def
using sats_snd_fm sats_snd2_fm sats_hcomp_fm[of A "is_snd(##A)" _ snd_fm "is_snd_snd(##A)"]
by simp
lemma is_cond_of_iff_sats [iff_sats]:
assumes
"nth(a,env) = x" "nth(b,env) = y" "aânat" "bânat" "env â list(A)"
shows
"is_cond_of(##A,x,y) ⷠA, env ⨠cond_of_fm(a,b)"
using assms sats_cond_of_fm
by simp
lemma components_type[TC] :
assumes "aânat" "bânat"
shows
"ftype_fm(a,b)âformula"
"name1_fm(a,b)âformula"
"name2_fm(a,b)âformula"
"cond_of_fm(a,b)âformula"
using assms
unfolding ftype_fm_def fst_fm_def snd_fm_def snd_snd_fm_def name1_fm_def name2_fm_def
cond_of_fm_def hcomp_fm_def
by simp_all
lemmas components_iff_sats = is_ftype_iff_sats is_name1_iff_sats is_name2_iff_sats
is_cond_of_iff_sats
lemmas components_defs = ftype_fm_def snd_snd_fm_def hcomp_fm_def
name1_fm_def name2_fm_def cond_of_fm_def
definition
is_eclose_n :: "[iâo,[iâo,i,i]âo,i,i] â o" where
"is_eclose_n(N,is_name,en,t) â¡
ân1[N].âs1[N]. is_name(N,t,n1) â§ is_singleton(N,n1,s1) â§ is_eclose(N,s1,en)"
definition
eclose_n1_fm :: "[i,i] â i" where
"eclose_n1_fm(m,t) â¡ Exists(Exists(And(And(name1_fm(t+â©Ï2,0),singleton_fm(0,1)),
is_eclose_fm(1,m+â©Ï2))))"
definition
eclose_n2_fm :: "[i,i] â i" where
"eclose_n2_fm(m,t) â¡ Exists(Exists(And(And(name2_fm(t+â©Ï2,0),singleton_fm(0,1)),
is_eclose_fm(1,m+â©Ï2))))"
definition
is_ecloseN :: "[iâo,i,i] â o" where
"is_ecloseN(N,t,en) â¡ âen1[N].âen2[N].
is_eclose_n(N,is_name1,en1,t) â§ is_eclose_n(N,is_name2,en2,t)â§
union(N,en1,en2,en)"
definition
ecloseN_fm :: "[i,i] â i" where
"ecloseN_fm(en,t) â¡ Exists(Exists(And(eclose_n1_fm(1,t+â©Ï2),
And(eclose_n2_fm(0,t+â©Ï2),union_fm(1,0,en+â©Ï2)))))"
lemma ecloseN_fm_type [TC] :
"⦠en â nat ; t â nat â§ â¹ ecloseN_fm(en,t) â formula"
unfolding ecloseN_fm_def eclose_n1_fm_def eclose_n2_fm_def by simp
lemma sats_ecloseN_fm [simp]:
"⦠en â nat; t â nat ; env â list(A) â§
⹠(A, env ⨠ecloseN_fm(en,t)) ⷠis_ecloseN(##A,nth(t,env),nth(en,env))"
unfolding ecloseN_fm_def is_ecloseN_def eclose_n1_fm_def eclose_n2_fm_def is_eclose_n_def
using nth_0 nth_ConsI sats_name1_fm sats_name2_fm singleton_iff_sats[symmetric]
by auto
lemma is_ecloseN_iff_sats [iff_sats]:
"⦠nth(en, env) = ena; nth(t, env) = ta; en â nat; t â nat ; env â list(A) â§
⹠is_ecloseN(##A,ta,ena) ⷠA, env ⨠ecloseN_fm(en,t)"
by simp
definition
frecR :: "i â i â o" where
"frecR(x,y) â¡
(ftype(x) = 1 â§ ftype(y) = 0
â§ (name1(x) â domain(name1(y)) ⪠domain(name2(y)) â§ (name2(x) = name1(y) ⨠name2(x) = name2(y))))
⨠(ftype(x) = 0 â§ ftype(y) = 1 â§ name1(x) = name1(y) â§ name2(x) â domain(name2(y)))"
lemma frecR_ftypeD :
assumes "frecR(x,y)"
shows "(ftype(x) = 0 ⧠ftype(y) = 1) ⨠(ftype(x) = 1 ⧠ftype(y) = 0)"
using assms unfolding frecR_def by auto
lemma frecRI1: "s â domain(n1) ⨠s â domain(n2) â¹ frecR(â¨1, s, n1, qâ©, â¨0, n1, n2, q'â©)"
unfolding frecR_def by (simp add:components_simp)
lemma frecRI1': "s â domain(n1) ⪠domain(n2) â¹ frecR(â¨1, s, n1, qâ©, â¨0, n1, n2, q'â©)"
unfolding frecR_def by (simp add:components_simp)
lemma frecRI2: "s â domain(n1) ⨠s â domain(n2) â¹ frecR(â¨1, s, n2, qâ©, â¨0, n1, n2, q'â©)"
unfolding frecR_def by (simp add:components_simp)
lemma frecRI2': "s â domain(n1) ⪠domain(n2) â¹ frecR(â¨1, s, n2, qâ©, â¨0, n1, n2, q'â©)"
unfolding frecR_def by (simp add:components_simp)
lemma frecRI3: "â¨s, râ© â n2 â¹ frecR(â¨0, n1, s, qâ©, â¨1, n1, n2, q'â©)"
unfolding frecR_def by (auto simp add:components_simp)
lemma frecRI3': "s â domain(n2) â¹ frecR(â¨0, n1, s, qâ©, â¨1, n1, n2, q'â©)"
unfolding frecR_def by (auto simp add:components_simp)
lemma frecR_D1 :
"frecR(x,y) â¹ ftype(y) = 0 â¹ ftype(x) = 1 â§
(name1(x) â domain(name1(y)) ⪠domain(name2(y)) â§ (name2(x) = name1(y) ⨠name2(x) = name2(y)))"
unfolding frecR_def
by auto
lemma frecR_D2 :
"frecR(x,y) â¹ ftype(y) = 1 â¹ ftype(x) = 0 â§
ftype(x) = 0 â§ ftype(y) = 1 â§ name1(x) = name1(y) â§ name2(x) â domain(name2(y))"
unfolding frecR_def
by auto
lemma frecR_DI :
assumes "frecR(â¨a,b,c,dâ©,â¨ftype(y),name1(y),name2(y),cond_of(y)â©)"
shows "frecR(â¨a,b,c,dâ©,y)"
using assms
unfolding frecR_def
by (force simp add:components_simp)
reldb_add "ftype" "is_ftype"
reldb_add "name1" "is_name1"
reldb_add "name2" "is_name2"
relativize "frecR" "is_frecR"
schematic_goal sats_frecR_fm_auto:
assumes
"iânat" "jânat" "envâlist(A)"
shows
"is_frecR(##A,nth(i,env),nth(j,env)) ⷠA, env ⨠?fr_fm(i,j)"
unfolding is_frecR_def
by (insert assms ; (rule sep_rules' cartprod_iff_sats components_iff_sats
| simp del:sats_cartprod_fm)+)
synthesize "frecR" from_schematic sats_frecR_fm_auto
textâ¹Third item of Kunen's observations (p. 257) about the trcl relation.âº
lemma eq_ftypep_not_frecrR:
assumes "ftype(x) = ftype(y)"
shows "¬ frecR(x,y)"
using assms frecR_ftypeD by force
definition
rank_names :: "i â i" where
"rank_names(x) â¡ max(rank(name1(x)),rank(name2(x)))"
lemma rank_names_types [TC]:
shows "Ord(rank_names(x))"
unfolding rank_names_def max_def using Ord_rank Ord_Un by auto
definition
mtype_form :: "i â i" where
"mtype_form(x) â¡ if rank(name1(x)) < rank(name2(x)) then 0 else 2"
definition
type_form :: "i â i" where
"type_form(x) â¡ if ftype(x) = 0 then 1 else mtype_form(x)"
lemma type_form_tc [TC]:
shows "type_form(x) â 3"
unfolding type_form_def mtype_form_def by auto
lemma frecR_le_rnk_names :
assumes "frecR(x,y)"
shows "rank_names(x)â¤rank_names(y)"
proof -
obtain a b c d where
H: "a = name1(x)" "b = name2(x)"
"c = name1(y)" "d = name2(y)"
"(a â domain(c)âªdomain(d) â§ (b=c ⨠b = d)) ⨠(a = c â§ b â domain(d))"
using assms
unfolding frecR_def
by force
then
consider
(m) "a â domain(c) â§ (b = c ⨠b = d) "
| (n) "a â domain(d) â§ (b = c ⨠b = d)"
| (o) "b â domain(d) â§ a = c"
by auto
then
show ?thesis
proof(cases)
case m
then
have "rank(a) < rank(c)"
using eclose_rank_lt in_dom_in_eclose
by simp
with â¹rank(a) < rank(c)⺠H m
show ?thesis
unfolding rank_names_def
using Ord_rank max_cong max_cong2 leI
by auto
next
case n
then
have "rank(a) < rank(d)"
using eclose_rank_lt in_dom_in_eclose
by simp
with â¹rank(a) < rank(d)⺠H n
show ?thesis
unfolding rank_names_def
using Ord_rank max_cong2 max_cong max_commutes[of "rank(c)" "rank(d)"] leI
by auto
next
case o
then
have "rank(b) < rank(d)" (is "?b < ?d") "rank(a) = rank(c)" (is "?a = _")
using eclose_rank_lt in_dom_in_eclose
by simp_all
with H
show ?thesis
unfolding rank_names_def
using Ord_rank max_commutes max_cong2[OF leI[OF â¹?b < ?dâº], of ?a]
by simp
qed
qed
definition
Î :: "i â i" where
"Î(x) = 3 ** rank_names(x) ++ type_form(x)"
lemma Î_type [TC]:
shows "Ord(Î(x))"
unfolding Î_def by simp
lemma Î_mono :
assumes "frecR(x,y)"
shows "Î(x) < Î(y)"
proof -
have F: "type_form(x) < 3" "type_form(y) < 3"
using ltI
by simp_all
from assms
have A: "rank_names(x) ⤠rank_names(y)" (is "?x ⤠?y")
using frecR_le_rnk_names
by simp
then
have "Ord(?y)"
unfolding rank_names_def
using Ord_rank max_def
by simp
note leE[OF â¹?xâ¤?yâº]
then
show ?thesis
proof(cases)
case 1
then
show ?thesis
unfolding Î_def
using oadd_lt_mono2 �x < ?y⺠F
by auto
next
case 2
consider (a) "ftype(x) = 0 â§ ftype(y) = 1" | (b) "ftype(x) = 1 â§ ftype(y) = 0"
using frecR_ftypeD[OF â¹frecR(x,y)âº]
by auto
then show ?thesis
proof(cases)
case b
moreover from this
have "type_form(y) = 1"
using type_form_def by simp
moreover from calculation
have "name2(x) = name1(y) ⨠name2(x) = name2(y) " (is "?Ï = ?Ï' ⨠?Ï = ?Ï'")
"name1(x) â domain(name1(y)) ⪠domain(name2(y))" (is "?Ï â domain(?Ï') ⪠domain(?Ï')")
using assms unfolding type_form_def frecR_def by auto
moreover from calculation
have E: "rank(?Ï) = rank(?Ï') ⨠rank(?Ï) = rank(?Ï')" by auto
from calculation
consider (c) "rank(?Ï) < rank(?Ï')" | (d) "rank(?Ï) < rank(?Ï')"
using eclose_rank_lt in_dom_in_eclose by force
then
have "rank(?Ï) < rank(?Ï)"
proof (cases)
case c
with â¹rank_names(x) = rank_names(y) âº
show ?thesis
unfolding rank_names_def mtype_form_def type_form_def
using max_D2[OF E c] E assms Ord_rank
by simp
next
case d
with â¹rank_names(x) = rank_names(y) âº
show ?thesis
unfolding rank_names_def mtype_form_def type_form_def
using max_D2[OF _ d] max_commutes E assms Ord_rank disj_commute
by simp
qed
with b
have "type_form(x) = 0" unfolding type_form_def mtype_form_def by simp
with â¹rank_names(x) = rank_names(y) ⺠â¹type_form(y) = 1⺠â¹type_form(x) = 0âº
show ?thesis
unfolding Î_def by auto
next
case a
then
have "name1(x) = name1(y)" (is "?Ï = ?Ï'")
"name2(x) â domain(name2(y))" (is "?Ï â domain(?Ï')")
"type_form(x) = 1"
using assms
unfolding type_form_def frecR_def
by auto
then
have "rank(?Ï) = rank(?Ï')" "rank(?Ï) < rank(?Ï')"
using eclose_rank_lt in_dom_in_eclose
by simp_all
with â¹rank_names(x) = rank_names(y) âº
have "rank(?Ï') ⤠rank(?Ï')"
using Ord_rank max_D1
unfolding rank_names_def
by simp
with a
have "type_form(y) = 2"
unfolding type_form_def mtype_form_def
using not_lt_iff_le assms
by simp
with â¹rank_names(x) = rank_names(y) ⺠â¹type_form(y) = 2⺠â¹type_form(x) = 1âº
show ?thesis
unfolding Î_def by auto
qed
qed
qed
definition
frecrel :: "i â i" where
"frecrel(A) â¡ Rrel(frecR,A)"
lemma frecrelI :
assumes "x â A" "yâA" "frecR(x,y)"
shows "â¨x,yâ©âfrecrel(A)"
using assms unfolding frecrel_def Rrel_def by auto
lemma frecrelD :
assumes "â¨x,yâ© â frecrel(A1ÃA2ÃA3ÃA4)"
shows
"ftype(x) â A1" "ftype(x) â A1"
"name1(x) â A2" "name1(y) â A2"
"name2(x) â A3" "name2(x) â A3"
"cond_of(x) â A4" "cond_of(y) â A4"
"frecR(x,y)"
using assms
unfolding frecrel_def Rrel_def ftype_def by (auto simp add:components_simp)
lemma wf_frecrel :
shows "wf(frecrel(A))"
proof -
have "frecrel(A) â measure(A,Î)"
unfolding frecrel_def Rrel_def measure_def
using Î_mono
by force
then
show ?thesis
using wf_subset wf_measure by auto
qed
lemma core_induction_aux:
fixes A1 A2 :: "i"
assumes
"Transset(A1)"
"âÏ Î¸ p. p â A2 â¹ â¦âq Ï. ⦠qâA2 ; Ïâdomain(θ)â§ â¹ Q(0,Ï,Ï,q)â§ â¹ Q(1,Ï,θ,p)"
"âÏ Î¸ p. p â A2 â¹ â¦âq Ï. ⦠qâA2 ; Ïâdomain(Ï) ⪠domain(θ)â§ â¹ Q(1,Ï,Ï,q) â§ Q(1,Ï,θ,q)â§ â¹ Q(0,Ï,θ,p)"
shows "aâ2ÃA1ÃA1ÃA2 â¹ Q(ftype(a),name1(a),name2(a),cond_of(a))"
proof (induct a rule:wf_induct[OF wf_frecrel[of "2ÃA1ÃA1ÃA2"]])
case (1 x)
let ?Ï = "name1(x)"
let ?θ = "name2(x)"
let ?D = "2ÃA1ÃA1ÃA2"
assume "x â ?D"
then
have "cond_of(x)âA2"
by (auto simp add:components_simp)
from â¹xâ?Dâº
consider (eq) "ftype(x)=0" | (mem) "ftype(x)=1"
by (auto simp add:components_simp)
then
show ?case
proof cases
case eq
then
have "Q(1, Ï, ?Ï, q) â§ Q(1, Ï, ?θ, q)" if "Ï â domain(?Ï) ⪠domain(?θ)" and "qâA2" for q Ï
proof -
from 1
have "?ÏâA1" "?θâA1" "?Ïâeclose(A1)" "?θâeclose(A1)"
using arg_into_eclose
by (auto simp add:components_simp)
moreover from â¹Transset(A1)⺠that(1)
have "Ïâeclose(?Ï) ⪠eclose(?θ)"
using in_dom_in_eclose
by auto
then
have "ÏâA1"
using mem_eclose_subset[OF â¹?ÏâA1âº] mem_eclose_subset[OF â¹?θâA1âº]
Transset_eclose_eq_arg[OF â¹Transset(A1)âº]
by auto
with â¹qâA2⺠â¹?θ â A1⺠â¹cond_of(x)âA2⺠â¹?ÏâA1âº
have "frecR(â¨1, Ï, ?Ï, qâ©, x)" (is "frecR(?T,_)")
"frecR(â¨1, Ï, ?θ, qâ©, x)" (is "frecR(?U,_)")
using frecRI1'[OF that(1)] frecR_DI â¹ftype(x) = 0âº
frecRI2'[OF that(1)]
by (auto simp add:components_simp)
with â¹xâ?D⺠â¹ÏâA1⺠â¹qâA2âº
have "â¨?T,xâ©â frecrel(?D)" "â¨?U,xâ©â frecrel(?D)"
using frecrelI[of ?T ?D x] frecrelI[of ?U ?D x]
by (auto simp add:components_simp)
with â¹qâA2⺠â¹ÏâA1⺠â¹?ÏâA1⺠â¹?θâA1âº
have "Q(1, Ï, ?Ï, q)"
using 1
by (force simp add:components_simp)
moreover from â¹qâA2⺠â¹ÏâA1⺠â¹?ÏâA1⺠â¹?θâA1⺠â¹â¨?U,xâ©â frecrel(?D)âº
have "Q(1, Ï, ?θ, q)"
using 1 by (force simp add:components_simp)
ultimately
show ?thesis
by simp
qed
with assms(3) â¹ftype(x) = 0⺠â¹cond_of(x)âA2âº
show ?thesis
by auto
next
case mem
have "Q(0, ?Ï, Ï, q)" if "Ï â domain(?θ)" and "qâA2" for q Ï
proof -
from 1 assms
have "?ÏâA1" "?θâA1" "cond_of(x)âA2" "?Ïâeclose(A1)" "?θâeclose(A1)"
using arg_into_eclose
by (auto simp add:components_simp)
with â¹Transset(A1)⺠that(1)
have "Ïâ eclose(?θ)"
using in_dom_in_eclose
by auto
then
have "ÏâA1"
using mem_eclose_subset[OF â¹?θâA1âº] Transset_eclose_eq_arg[OF â¹Transset(A1)âº]
by auto
with â¹qâA2⺠â¹?θ â A1⺠â¹cond_of(x)âA2⺠â¹?ÏâA1⺠â¹ftype(x) = 1âº
have "frecR(â¨0, ?Ï, Ï, qâ©, x)" (is "frecR(?T,_)")
using frecRI3'[OF that(1)] frecR_DI
by (auto simp add:components_simp)
with â¹xâ?D⺠â¹ÏâA1⺠â¹qâA2⺠â¹?ÏâA1âº
have "â¨?T,xâ©â frecrel(?D)" "?Tâ?D"
using frecrelI[of ?T ?D x]
by (auto simp add:components_simp)
with â¹qâA2⺠â¹ÏâA1⺠â¹?ÏâA1⺠â¹?θâA1⺠1
show ?thesis
by (force simp add:components_simp)
qed
with assms(2) â¹ftype(x) = 1⺠â¹cond_of(x)âA2âº
show ?thesis
by auto
qed
qed
lemma def_frecrel : "frecrel(A) = {zâAÃA. âx y. z = â¨x, yâ© â§ frecR(x,y)}"
unfolding frecrel_def Rrel_def ..
lemma frecrel_fst_snd:
"frecrel(A) = {z â AÃA .
ftype(fst(z)) = 1 â§
ftype(snd(z)) = 0 â§ name1(fst(z)) â domain(name1(snd(z))) ⪠domain(name2(snd(z))) â§
(name2(fst(z)) = name1(snd(z)) ⨠name2(fst(z)) = name2(snd(z)))
⨠(ftype(fst(z)) = 0 â§
ftype(snd(z)) = 1 â§ name1(fst(z)) = name1(snd(z)) â§ name2(fst(z)) â domain(name2(snd(z))))}"
unfolding def_frecrel frecR_def
by (intro equalityI subsetI CollectI; elim CollectE; auto)
endody>
Theory FrecR_Arities
theory FrecR_Arities
imports
FrecR
begin
context
notes FOL_arities[simp]
begin
arity_theorem intermediate for "fst_fm"
lemma arity_fst_fm [arity] :
"â¦xânat ; tânatâ§ â¹ arity(fst_fm(x,t)) = succ(x) ⪠succ(t)"
using arity_fst_fm'
by auto
arity_theorem intermediate for "snd_fm"
lemma arity_snd_fm [arity] :
"â¦xânat ; tânatâ§ â¹ arity(snd_fm(x,t)) = succ(x) ⪠succ(t)"
using arity_snd_fm'
by auto
lemma arity_snd_snd_fm [arity] :
"â¦xânat ; tânatâ§ â¹ arity(snd_snd_fm(x,t)) = succ(x) ⪠succ(t)"
unfolding snd_snd_fm_def hcomp_fm_def
using arity_snd_fm arity_empty_fm union_abs2 pred_Un_distrib
by auto
lemma arity_ftype_fm [arity] :
"â¦xânat ; tânatâ§ â¹ arity(ftype_fm(x,t)) = succ(x) ⪠succ(t)"
unfolding ftype_fm_def
using arity_fst_fm
by auto
lemma arity_name1_fm [arity] :
"â¦xânat ; tânatâ§ â¹ arity(name1_fm(x,t)) = succ(x) ⪠succ(t)"
unfolding name1_fm_def hcomp_fm_def
using arity_fst_fm arity_snd_fm union_abs2 pred_Un_distrib
by auto
lemma arity_name2_fm [arity] :
"â¦xânat ; tânatâ§ â¹ arity(name2_fm(x,t)) = succ(x) ⪠succ(t)"
unfolding name2_fm_def hcomp_fm_def
using arity_fst_fm arity_snd_snd_fm union_abs2 pred_Un_distrib
by auto
lemma arity_cond_of_fm [arity] :
"â¦xânat ; tânatâ§ â¹ arity(cond_of_fm(x,t)) = succ(x) ⪠succ(t)"
unfolding cond_of_fm_def hcomp_fm_def
using arity_snd_fm arity_snd_snd_fm union_abs2 pred_Un_distrib
by auto
lemma arity_eclose_n1_fm [arity] :
"â¦xânat ; tânatâ§ â¹ arity(eclose_n1_fm(x,t)) = succ(x) ⪠succ(t)"
unfolding eclose_n1_fm_def
using arity_is_eclose_fm arity_singleton_fm arity_name1_fm union_abs2 pred_Un_distrib
by auto
lemma arity_eclose_n2_fm [arity] :
"â¦xânat ; tânatâ§ â¹ arity(eclose_n2_fm(x,t)) = succ(x) ⪠succ(t)"
unfolding eclose_n2_fm_def
using arity_is_eclose_fm arity_singleton_fm arity_name2_fm union_abs2 pred_Un_distrib
by auto
lemma arity_ecloseN_fm [arity] :
"â¦xânat ; tânatâ§ â¹ arity(ecloseN_fm(x,t)) = succ(x) ⪠succ(t)"
unfolding ecloseN_fm_def
using arity_eclose_n1_fm arity_eclose_n2_fm arity_union_fm union_abs2 pred_Un_distrib
by auto
lemma arity_frecR_fm [arity]:
"â¦aânat;bânatâ§ â¹ arity(frecR_fm(a,b)) = succ(a) ⪠succ(b)"
unfolding frecR_fm_def
using arity_ftype_fm arity_name1_fm arity_name2_fm arity_domain_fm
arity_empty_fm arity_union_fm pred_Un_distrib arity_succ_fm
by auto
end
endbody>
Theory Fm_Definitions
sectionâ¹Concepts involved in instances of Replacementâº
theory Fm_Definitions
imports
Transitive_Models.Renaming_Auto
Transitive_Models.Aleph_Relative
FrecR_Arities
begin
txtâ¹In this theory we put every concept that should be synthesized in a formula
to have an instance of replacement.
The automatic synthesis of a concept /foo/ requires that every concept used to
define /foo/ is already synthesized. We try to use our meta-programs to synthesize
concepts: given the absolute concept /foo/ we relativize in relational form
obtaining /is\_foo/ and the we synthesize the formula /is\_foo\_fm/.
The meta-program that synthesizes formulas also produce satisfactions lemmas.
Having one file to collect every formula needed for replacements breaks
the reading flow: we need to introduce the concept in this theory in order
to use the meta-programs; moreover there are some concepts for which we prove
here the satisfaction lemmas manually, while for others we prove them
on its theory.
âº
declare arity_subset_fm [simp del] arity_ordinal_fm[simp del, arity] arity_transset_fm[simp del]
FOL_arities[simp del]
txtâ¹Formulas for particular replacement instancesâº
textâ¹Now we introduce some definitions used in the definition of check; which
is defined by well-founded recursion using replacement in the recursive call.âº
definition
rcheck :: "i â i" where
"rcheck(x) â¡ Memrel(eclose({x}))^+"
relativize "rcheck" "is_rcheck"
synthesize "is_rcheck" from_definition
arity_theorem for "is_rcheck_fm"
definition
PHcheck :: "[iâo,i,i,i,i] â o" where
"PHcheck(M,o,f,y,p) â¡ M(p) â§ (âfy[M]. fun_apply(M,f,y,fy) â§ pair(M,fy,o,p))"
synthesize "PHcheck" from_definition assuming "nonempty"
arity_theorem for "PHcheck_fm"
definition
is_Hcheck :: "[iâo,i,i,i,i] â o" where
"is_Hcheck(M,o,z,f,hc) â¡ is_Replace(M,z,PHcheck(M,o,f),hc)"
synthesize "is_Hcheck" from_definition assuming "nonempty"
lemma arity_is_Hcheck_fm:
assumes "mânat" "nânat" "pânat" "oânat"
shows "arity(is_Hcheck_fm(m,n,p,o)) = succ(o) ⪠succ(n) ⪠succ(p) ⪠succ(m) "
unfolding is_Hcheck_fm_def
using assms arity_Replace_fm[rule_format,OF PHcheck_fm_type _ _ _ arity_PHcheck_fm]
pred_Un_distrib Un_assoc Un_nat_type
by simp
definition
is_check :: "[iâo,i,i,i] â o" where
"is_check(M,o,x,z) â¡ ârch[M]. is_rcheck(M,x,rch) â§
is_wfrec(M,is_Hcheck(M,o),rch,x,z)"
definition
check_fm :: "[i,i,i] â i" where
"check_fm(x,o,z) â¡ Exists(And(is_rcheck_fm(1+â©Ïx,0),
is_wfrec_fm(is_Hcheck_fm(6+â©Ïo,2,1,0),0,1+â©Ïx,1+â©Ïz)))"
lemma check_fm_type[TC]: "xânat â¹ oânat â¹ zânat â¹ check_fm(x,o,z) â formula"
by (simp add:check_fm_def)
lemma sats_check_fm :
assumes
"oânat" "xânat" "zânat" "envâlist(M)" "0âM"
shows
"(M , env ⨠check_fm(x,o,z)) ⷠis_check(##M,nth(o,env),nth(x,env),nth(z,env))"
proof -
have sats_is_Hcheck_fm:
"âa0 a1 a2 a3 a4 a6. ⦠a0âM; a1âM; a2âM; a3âM; a4âM;a6 âMâ§ â¹
is_Hcheck(##M,a6,a2, a1, a0) â·
(M , [a0,a1,a2,a3,a4,r,a6]@env ⨠is_Hcheck_fm(6,2,1,0))" if "râM" for r
using that assms
by simp
then
have "(M , [r]@env ⨠is_wfrec_fm(is_Hcheck_fm(6+â©Ïo,2,1,0),0,1+â©Ïx,1+â©Ïz))
â· is_wfrec(##M,is_Hcheck(##M,nth(o,env)),r,nth(x,env),nth(z,env))"
if "râM" for r
using that assms is_wfrec_iff_sats'[symmetric]
by simp
then
show ?thesis
unfolding is_check_def check_fm_def
using assms is_rcheck_iff_sats[symmetric]
by simp
qed
lemma iff_sats_check_fm[iff_sats] :
assumes
"nth(o, env) = oa" "nth(x, env) = xa" "nth(z, env) = za" "o â nat" "x â nat" "z â nat" "env â list(A)" "0 â A"
shows "is_check(##A, oa,xa, za) ⷠA, env ⨠check_fm(x,o, z)"
using assms sats_check_fm[symmetric]
by auto
lemma arity_check_fm[arity]:
assumes "mânat" "nânat" "oânat"
shows "arity(check_fm(m,n,o)) = succ(o) ⪠succ(n) ⪠succ(m) "
unfolding check_fm_def
using assms arity_is_wfrec_fm[rule_format,OF _ _ _ _ _ arity_is_Hcheck_fm]
pred_Un_distrib Un_assoc arity_tran_closure_fm
by (auto simp add:arity)
notation check_fm (â¹â
_â§v_ is _â
âº)
subsectionâ¹Names for forcing the Axiom of Choice.âº
definition
upair_name :: "i â i â i â i" where
"upair_name(Ï,Ï,on) â¡ Upair(â¨Ï,onâ©,â¨Ï,onâ©)"
relativize "upair_name" "is_upair_name"
synthesize "upair_name" from_definition "is_upair_name"
arity_theorem for "upair_name_fm"
definition
opair_name :: "i â i â i â i" where
"opair_name(Ï,Ï,on) â¡ upair_name(upair_name(Ï,Ï,on),upair_name(Ï,Ï,on),on)"
relativize "opair_name" "is_opair_name"
synthesize "opair_name" from_definition "is_opair_name"
arity_theorem for "opair_name_fm"
definition
is_opname_check :: "[iâo,i,i,i,i] â o" where
"is_opname_check(M,on,s,x,y) â¡ âchx[M]. âsx[M]. is_check(M,on,x,chx) â§
fun_apply(M,s,x,sx) â§ is_opair_name(M,chx,sx,on,y)"
synthesize "is_opname_check" from_definition assuming "nonempty"
arity_theorem for "is_opname_check_fm"
definition
is_leq :: "[iâo,i,i,i] â o" where
"is_leq(A,l,q,p) â¡ âqp[A]. (pair(A,q,p,qp) â§ qpâl)"
synthesize "is_leq" from_definition assuming "nonempty"
arity_theorem for "is_leq_fm"
abbreviation
fm_leq :: "[i,i,i] â i" (â¹â
_â¼â_â_â
âº) where
"fm_leq(A,l,B) â¡ is_leq_fm(l,A,B)"
subsectionâ¹Formulas used to prove some generic instances.âº
definition Ï_repl :: "iâi" where
"Ï_repl(l) â¡ rsum({â¨0, 1â©, â¨1, 0â©}, id(l), 2, 3, l)"
lemma f_type : "{â¨0, 1â©, â¨1, 0â©} â 2 â 3"
using Pi_iff unfolding function_def by auto
hide_fact Internalize.sum_type
lemma ren_type :
assumes "lânat"
shows "Ï_repl(l) : 2+â©Ïl â 3+â©Ïl"
using sum_type[of 2 3 l l "{â¨0, 1â©, â¨1, 0â©}" "id(l)"] f_type assms id_type
unfolding Ï_repl_def by auto
definition Lambda_in_M_fm where [simp]:"Lambda_in_M_fm(Ï,len) â¡
â
(â
ââ
pair_fm(1, 0, 2) â§
ren(Ï) ` (2 +â©Ï len) ` (3 +â©Ï len) ` Ï_repl(len) â
â
) â§ â
0 â len +â©Ï 2â
â
"
lemma Lambda_in_M_fm_type[TC]: "Ïâformula â¹ lenânat â¹ Lambda_in_M_fm(Ï,len) âformula"
using ren_tc[of Ï "2+â©Ïlen" "3+â©Ïlen" "Ï_repl(len)"] ren_type
unfolding Lambda_in_M_fm_def
by simp
definition Ï_pair_repl :: "iâi" where
"Ï_pair_repl(l) â¡ rsum({â¨0, 0â©, â¨1, 1â©, â¨2, 3â©}, id(l), 3, 4, l)"
definition LambdaPair_in_M_fm where "LambdaPair_in_M_fm(Ï,len) â¡
â
(â
ââ
pair_fm(1, 0, 2) â§
ren((â
â(â
ââ
â
fst(2) is 0â
â§ â
â
snd(2) is 1â
â§ ren(Ï) ` (3 +â©Ï len) ` (4 +â©Ï len) ` Ï_pair_repl(len) â
â
â
)â
)) ` (2 +â©Ï len) `
(3 +â©Ï len) `
Ï_repl(len) â
â
) â§
â
0 â len +â©Ï 2â
â
"
lemma f_type' : "{â¨0,0 â©, â¨1, 1â©, â¨2, 3â©} â 3 â 4"
using Pi_iff unfolding function_def by auto
lemma ren_type' :
assumes "lânat"
shows "Ï_pair_repl(l) : 3+â©Ïl â 4+â©Ïl"
using sum_type[of 3 4 l l "{â¨0, 0â©, â¨1, 1â©, â¨2, 3â©}" "id(l)"] f_type' assms id_type
unfolding Ï_pair_repl_def by auto
lemma LambdaPair_in_M_fm_type[TC]: "Ïâformula â¹ lenânat â¹ LambdaPair_in_M_fm(Ï,len) âformula"
using ren_tc[OF _ _ _ ren_type',of Ï "len"] Lambda_in_M_fm_type
unfolding LambdaPair_in_M_fm_def
by simp
subsectionâ¹The relation \<^term>â¹frecrelâºâº
definition
frecrelP :: "[iâo,i] â o" where
"frecrelP(M,xy) â¡ (âx[M]. ây[M]. pair(M,x,y,xy) â§ is_frecR(M,x,y))"
synthesize "frecrelP" from_definition
arity_theorem for "frecrelP_fm"
definition
is_frecrel :: "[iâo,i,i] â o" where
"is_frecrel(M,A,r) â¡ âA2[M]. cartprod(M,A,A,A2) â§ is_Collect(M,A2, frecrelP(M) ,r)"
synthesize "frecrel" from_definition "is_frecrel"
arity_theorem for "frecrel_fm"
definition
names_below :: "i â i â i" where
"names_below(P,x) â¡ 2ÃecloseN(x)ÃecloseN(x)ÃP"
lemma names_belowsD:
assumes "x â names_below(P,z)"
obtains f n1 n2 p where
"x = â¨f,n1,n2,pâ©" "fâ2" "n1âecloseN(z)" "n2âecloseN(z)" "pâP"
using assms unfolding names_below_def by auto
synthesize "number2" from_definition
lemma number2_iff :
"(A)(c) â¹ number2(A,c) â· (âb[A]. âa[A]. successor(A, b, c) â§ successor(A, a, b) â§ empty(A, a))"
unfolding number2_def number1_def by auto
arity_theorem for "number2_fm"
reldb_add "ecloseN" "is_ecloseN"
relativize "names_below" "is_names_below"
synthesize "is_names_below" from_definition
arity_theorem for "is_names_below_fm"
definition
is_tuple :: "[iâo,i,i,i,i,i] â o" where
"is_tuple(M,z,t1,t2,p,t) â¡ ât1t2p[M]. ât2p[M]. pair(M,t2,p,t2p) â§ pair(M,t1,t2p,t1t2p) â§
pair(M,z,t1t2p,t)"
synthesize "is_tuple" from_definition
arity_theorem for "is_tuple_fm"
subsectionâ¹Definition of Forcesâº
subsubsectionâ¹Definition of \<^term>â¹forces⺠for equality and membershipâº
textâ¹$p\forces \tau = \theta$ if every $q\leqslant p$ both $q\forces \sigma \in \tau$
and $q\forces \sigma \in \theta$ for every $\sigma \in \dom(\tau)\cup \dom(\theta)$.âº
definition
eq_case :: "[i,i,i,i,i,i] â o" where
"eq_case(Ï,θ,p,P,leq,f) â¡ âÏ. Ï â domain(Ï) ⪠domain(θ) â¶
(âq. qâP â§ â¨q,pâ©âleq â¶ (f`â¨1,Ï,Ï,qâ©=1 â· f`â¨1,Ï,θ,qâ© =1))"
relativize "eq_case" "is_eq_case"
synthesize "eq_case" from_definition "is_eq_case"
textâ¹$p\forces \tau \in \theta$ if for every $v\leqslant p$
there exists $q$, $r$, and $\sigma$ such that
$v\leqslant q$, $q\leqslant r$, $\langle \sigma,r\rangle \in \tau$, and
$q\forces \pi = \sigma$.âº
definition
mem_case :: "[i,i,i,i,i,i] â o" where
"mem_case(Ï,θ,p,P,leq,f) â¡ âvâP. â¨v,pâ©âleq â¶
(âq. âÏ. âr. râP â§ qâP â§ â¨q,vâ©âleq â§ â¨Ï,râ© â θ â§ â¨q,râ©âleq â§ f`â¨0,Ï,Ï,qâ© = 1)"
relativize "mem_case" "is_mem_case"
synthesize "mem_case" from_definition "is_mem_case"
arity_theorem intermediate for "eq_case_fm"
lemma arity_eq_case_fm[arity]:
assumes
"n1ânat" "n2ânat" "pânat" "Pânat" "leqânat" "fânat"
shows
"arity(eq_case_fm(n1,n2,p,P,leq,f)) =
succ(n1) ⪠succ(n2) ⪠succ(p) ⪠succ(P) ⪠succ(leq) ⪠succ(f)"
using assms arity_eq_case_fm'
by auto
arity_theorem intermediate for "mem_case_fm"
lemma arity_mem_case_fm[arity] :
assumes
"n1ânat" "n2ânat" "pânat" "Pânat" "leqânat" "fânat"
shows
"arity(mem_case_fm(n1,n2,p,P,leq,f)) =
succ(n1) ⪠succ(n2) ⪠succ(p) ⪠succ(P) ⪠succ(leq) ⪠succ(f)"
using assms arity_mem_case_fm'
by auto
definition
Hfrc :: "[i,i,i,i] â o" where
"Hfrc(P,leq,fnnc,f) â¡ âft. âÏ. âθ. âp. pâP â§ fnnc = â¨ft,Ï,θ,pâ© â§
( ft = 0 â§ eq_case(Ï,θ,p,P,leq,f)
⨠ft = 1 â§ mem_case(Ï,θ,p,P,leq,f))"
relativize "Hfrc" "is_Hfrc"
synthesize "Hfrc" from_definition "is_Hfrc"
definition
is_Hfrc_at :: "[iâo,i,i,i,i,i] â o" where
"is_Hfrc_at(M,P,leq,fnnc,f,b) â¡
(empty(M,b) ⧠¬ is_Hfrc(M,P,leq,fnnc,f))
⨠(number1(M,b) ⧠is_Hfrc(M,P,leq,fnnc,f))"
synthesize "Hfrc_at" from_definition "is_Hfrc_at"
arity_theorem intermediate for "Hfrc_fm"
lemma arity_Hfrc_fm[arity] :
assumes
"Pânat" "leqânat" "fnncânat" "fânat"
shows
"arity(Hfrc_fm(P,leq,fnnc,f)) = succ(P) ⪠succ(leq) ⪠succ(fnnc) ⪠succ(f)"
using assms arity_Hfrc_fm'
by auto
arity_theorem for "Hfrc_at_fm"
subsubsectionâ¹The well-founded relation \<^term>â¹forcerelâºâº
definition
forcerel :: "i â i â i" where
"forcerel(P,x) â¡ frecrel(names_below(P,x))^+"
definition
is_forcerel :: "[iâo,i,i,i] â o" where
"is_forcerel(M,P,x,z) â¡ âr[M]. ânb[M]. tran_closure(M,r,z) â§
(is_names_below(M,P,x,nb) â§ is_frecrel(M,nb,r))"
synthesize "is_forcerel" from_definition
arity_theorem for "is_forcerel_fm"
subsectionâ¹\<^term>â¹frc_atâº, forcing for atomic formulasâº
definition
frc_at :: "[i,i,i] â i" where
"frc_at(P,leq,fnnc) â¡ wfrec(frecrel(names_below(P,fnnc)),fnnc,
λx f. bool_of_o(Hfrc(P,leq,x,f)))"
definition
is_frc_at :: "[iâo,i,i,i,i] â o" where
"is_frc_at(M,P,leq,x,z) â¡ âr[M]. is_forcerel(M,P,x,r) â§
is_wfrec(M,is_Hfrc_at(M,P,leq),r,x,z)"
definition
frc_at_fm :: "[i,i,i,i] â i" where
"frc_at_fm(p,l,x,z) â¡ Exists(And(is_forcerel_fm(succ(p),succ(x),0),
is_wfrec_fm(Hfrc_at_fm(6+â©Ïp,6+â©Ïl,2,1,0),0,succ(x),succ(z))))"
lemma frc_at_fm_type [TC] :
"â¦pânat;lânat;xânat;zânatâ§ â¹ frc_at_fm(p,l,x,z)âformula"
unfolding frc_at_fm_def by simp
lemma arity_frc_at_fm[arity] :
assumes "pânat" "lânat" "xânat" "zânat"
shows "arity(frc_at_fm(p,l,x,z)) = succ(p) ⪠succ(l) ⪠succ(x) ⪠succ(z)"
proof -
let ?Ï = "Hfrc_at_fm(6 +â©Ï p, 6 +â©Ï l, 2, 1, 0)"
note assms
moreover from this
have "arity(?Ï) = (7+â©Ïp) ⪠(7+â©Ïl)" "?Ï â formula"
using arity_Hfrc_at_fm ord_simp_union
by auto
moreover from calculation
have "arity(is_wfrec_fm(?Ï, 0, succ(x), succ(z))) = 2+â©Ïp ⪠(2+â©Ïl) ⪠(2+â©Ïx) ⪠(2+â©Ïz)"
using arity_is_wfrec_fm[OF â¹?Ïâ_⺠_ _ _ _ â¹arity(?Ï) = _âº] pred_Un_distrib pred_succ_eq
union_abs1
by auto
moreover from assms
have "arity(is_forcerel_fm(succ(p),succ(x),0)) = 2+â©Ïp ⪠(2+â©Ïx)"
using arity_is_forcerel_fm ord_simp_union
by auto
ultimately
show ?thesis
unfolding frc_at_fm_def
using arity_is_forcerel_fm pred_Un_distrib
by (auto simp:FOL_arities)
qed
lemma sats_frc_at_fm :
assumes
"pânat" "lânat" "iânat" "jânat" "envâlist(A)" "i < length(env)" "j < length(env)"
shows
"(A , env ⨠frc_at_fm(p,l,i,j)) â·
is_frc_at(##A,nth(p,env),nth(l,env),nth(i,env),nth(j,env))"
proof -
{
fix r pp ll
assume "râA"
have "is_Hfrc_at(##A,nth(p,env),nth(l,env),a2, a1, a0) â·
(A, [a0,a1,a2,a3,a4,r]@env ⨠Hfrc_at_fm(6+â©Ïp,6+â©Ïl,2,1,0))"
if "a0âA" "a1âA" "a2âA" "a3âA" "a4âA" for a0 a1 a2 a3 a4
using that assms â¹râAâº
Hfrc_at_iff_sats[of "6+â©Ïp" "6+â©Ïl" 2 1 0 "[a0,a1,a2,a3,a4,r]@env" A] by simp
with â¹râAâº
have "(A,[r]@env ⨠is_wfrec_fm(Hfrc_at_fm(6+â©Ïp, 6+â©Ïl,2,1,0),0, i+â©Ï1, j+â©Ï1)) â·
is_wfrec(##A, is_Hfrc_at(##A, nth(p,env), nth(l,env)), r,nth(i, env), nth(j, env))"
using assms sats_is_wfrec_fm
by simp
}
moreover
have "(A, Cons(r, env) ⨠is_forcerel_fm(succ(p), succ(i), 0)) â·
is_forcerel(##A,nth(p,env),nth(i,env),r)" if "râA" for r
using assms sats_is_forcerel_fm that
by simp
ultimately
show ?thesis
unfolding is_frc_at_def frc_at_fm_def
using assms
by simp
qed
lemma frc_at_fm_iff_sats:
assumes "nth(i,env) = w" "nth(j,env) = x" "nth(k,env) = y" "nth(l,env) = z"
"i â nat" "j â nat" "k â nat" "lânat" "env â list(A)" "k<length(env)" "l<length(env)"
shows "is_frc_at(##A, w, x, y,z) ⷠ(A , env ⨠frc_at_fm(i,j,k,l))"
using assms sats_frc_at_fm
by simp
declare frc_at_fm_iff_sats [iff_sats]
definition
forces_eq' :: "[i,i,i,i,i] â o" where
"forces_eq'(P,l,p,t1,t2) â¡ frc_at(P,l,â¨0,t1,t2,pâ©) = 1"
definition
forces_mem' :: "[i,i,i,i,i] â o" where
"forces_mem'(P,l,p,t1,t2) â¡ frc_at(P,l,â¨1,t1,t2,pâ©) = 1"
definition
forces_neq' :: "[i,i,i,i,i] â o" where
"forces_neq'(P,l,p,t1,t2) ⡠¬ (âqâP. â¨q,pâ©âl â§ forces_eq'(P,l,q,t1,t2))"
definition
forces_nmem' :: "[i,i,i,i,i] â o" where
"forces_nmem'(P,l,p,t1,t2) ⡠¬ (âqâP. â¨q,pâ©âl â§ forces_mem'(P,l,q,t1,t2))"
definition
is_forces_eq' :: "[iâo,i,i,i,i,i] â o" where
"is_forces_eq'(M,P,l,p,t1,t2) â¡ âo[M]. âz[M]. ât[M]. number1(M,o) â§ empty(M,z) â§
is_tuple(M,z,t1,t2,p,t) â§ is_frc_at(M,P,l,t,o)"
definition
is_forces_mem' :: "[iâo,i,i,i,i,i] â o" where
"is_forces_mem'(M,P,l,p,t1,t2) â¡ âo[M]. ât[M]. number1(M,o) â§
is_tuple(M,o,t1,t2,p,t) â§ is_frc_at(M,P,l,t,o)"
definition
is_forces_neq' :: "[iâo,i,i,i,i,i] â o" where
"is_forces_neq'(M,P,l,p,t1,t2) â¡
¬ (âq[M]. qâP â§ (âqp[M]. pair(M,q,p,qp) â§ qpâl â§ is_forces_eq'(M,P,l,q,t1,t2)))"
definition
is_forces_nmem' :: "[iâo,i,i,i,i,i] â o" where
"is_forces_nmem'(M,P,l,p,t1,t2) â¡
¬ (âq[M]. âqp[M]. qâP â§ pair(M,q,p,qp) â§ qpâl â§ is_forces_mem'(M,P,l,q,t1,t2))"
synthesize "forces_eq" from_definition "is_forces_eq'"
synthesize "forces_mem" from_definition "is_forces_mem'"
synthesize "forces_neq" from_definition "is_forces_neq'" assuming "nonempty"
synthesize "forces_nmem" from_definition "is_forces_nmem'" assuming "nonempty"
context
notes Un_assoc[simp] Un_trasposition_aux2[simp]
begin
arity_theorem for "forces_eq_fm"
arity_theorem for "forces_mem_fm"
arity_theorem for "forces_neq_fm"
arity_theorem for "forces_nmem_fm"
end
subsectionâ¹Forcing for general formulasâº
definition
ren_forces_nand :: "iâi" where
"ren_forces_nand(Ï) â¡ Exists(And(Equal(0,1),iterates(λp. incr_bv(p)`1 , 2, Ï)))"
lemma ren_forces_nand_type[TC] :
"Ïâformula â¹ ren_forces_nand(Ï) âformula"
unfolding ren_forces_nand_def
by simp
lemma arity_ren_forces_nand :
assumes "Ïâformula"
shows "arity(ren_forces_nand(Ï)) ⤠succ(arity(Ï))"
proof -
consider (lt) "1<arity(Ï)" | (ge) "¬ 1 < arity(Ï)"
by auto
then
show ?thesis
proof cases
case lt
with â¹Ïâ_âº
have "2 < succ(arity(Ï))" "2<arity(Ï)+â©Ï2"
using succ_ltI by auto
with â¹Ïâ_âº
have "arity(iterates(λp. incr_bv(p)`1,2,Ï)) = 2+â©Ïarity(Ï)"
using arity_incr_bv_lemma lt
by auto
with â¹Ïâ_âº
show ?thesis
unfolding ren_forces_nand_def
using lt pred_Un_distrib union_abs1 Un_assoc[symmetric] Un_le_compat
by (simp add:FOL_arities)
next
case ge
with â¹Ïâ_âº
have "arity(Ï) ⤠1" "pred(arity(Ï)) ⤠1"
using not_lt_iff_le le_trans[OF le_pred]
by simp_all
with â¹Ïâ_âº
have "arity(iterates(λp. incr_bv(p)`1,2,Ï)) = (arity(Ï))"
using arity_incr_bv_lemma ge
by simp
with â¹arity(Ï) ⤠1⺠â¹Ïâ_⺠â¹pred(_) ⤠1âº
show ?thesis
unfolding ren_forces_nand_def
using pred_Un_distrib union_abs1 Un_assoc[symmetric] union_abs2
by (simp add:FOL_arities)
qed
qed
lemma sats_ren_forces_nand:
"[q,P,leq,o,p] @ env â list(M) â¹ Ïâformula â¹
(M, [q,p,P,leq,o] @ env ⨠ren_forces_nand(Ï)) â· (M, [q,P,leq,o] @ env ⨠Ï)"
unfolding ren_forces_nand_def
using sats_incr_bv_iff [of _ _ M _ "[q]"]
by simp
definition
ren_forces_forall :: "iâi" where
"ren_forces_forall(Ï) â¡
Exists(Exists(Exists(Exists(Exists(
And(Equal(0,6),And(Equal(1,7),And(Equal(2,8),And(Equal(3,9),
And(Equal(4,5),iterates(λp. incr_bv(p)`5 , 5, Ï)))))))))))"
lemma arity_ren_forces_all :
assumes "Ïâformula"
shows "arity(ren_forces_forall(Ï)) = 5 ⪠arity(Ï)"
proof -
consider (lt) "5<arity(Ï)" | (ge) "¬ 5 < arity(Ï)"
by auto
then
show ?thesis
proof cases
case lt
with â¹Ïâ_âº
have "5 < succ(arity(Ï))" "5<arity(Ï)+â©Ï2" "5<arity(Ï)+â©Ï3" "5<arity(Ï)+â©Ï4"
using succ_ltI by auto
with â¹Ïâ_âº
have "arity(iterates(λp. incr_bv(p)`5,5,Ï)) = 5+â©Ïarity(Ï)"
using arity_incr_bv_lemma lt
by simp
with â¹Ïâ_âº
show ?thesis
unfolding ren_forces_forall_def
using pred_Un_distrib union_abs1 Un_assoc[symmetric] union_abs2
by (simp add:FOL_arities)
next
case ge
with â¹Ïâ_âº
have "arity(Ï) ⤠5" "pred^5(arity(Ï)) ⤠5"
using not_lt_iff_le le_trans[OF le_pred]
by simp_all
with â¹Ïâ_âº
have "arity(iterates(λp. incr_bv(p)`5,5,Ï)) = arity(Ï)"
using arity_incr_bv_lemma ge
by simp
with â¹arity(Ï) ⤠5⺠â¹Ïâ_⺠â¹pred^5(_) ⤠5âº
show ?thesis
unfolding ren_forces_forall_def
using pred_Un_distrib union_abs1 Un_assoc[symmetric] union_abs2
by (simp add:FOL_arities)
qed
qed
lemma ren_forces_forall_type[TC] :
"Ïâformula â¹ ren_forces_forall(Ï) âformula"
unfolding ren_forces_forall_def by simp
lemma sats_ren_forces_forall :
"[x,P,leq,o,p] @ env â list(M) â¹ Ïâformula â¹
(M, [x,p,P,leq,o] @ env ⨠ren_forces_forall(Ï)) â· (M, [p,P,leq,o,x] @ env ⨠Ï)"
unfolding ren_forces_forall_def
using sats_incr_bv_iff [of _ _ M _ "[p,P,leq,o,x]"]
by simp
subsubsectionâ¹The primitive recursionâº
consts forces' :: "iâi"
primrec
"forces'(Member(x,y)) = forces_mem_fm(1,2,0,x+â©Ï4,y+â©Ï4)"
"forces'(Equal(x,y)) = forces_eq_fm(1,2,0,x+â©Ï4,y+â©Ï4)"
"forces'(Nand(p,q)) =
Neg(Exists(And(Member(0,2),And(is_leq_fm(3,0,1),And(ren_forces_nand(forces'(p)),
ren_forces_nand(forces'(q)))))))"
"forces'(Forall(p)) = Forall(ren_forces_forall(forces'(p)))"
definition
forces :: "iâi" where
"forces(Ï) â¡ And(Member(0,1),forces'(Ï))"
lemma forces'_type [TC]: "Ïâformula â¹ forces'(Ï) â formula"
by (induct Ï set:formula; simp)
lemma forces_type[TC] : "Ïâformula â¹ forces(Ï) â formula"
unfolding forces_def by simp
subsectionâ¹The arity of \<^term>â¹forcesâºâº
lemma arity_forces_at:
assumes "x â nat" "y â nat"
shows "arity(forces(Member(x, y))) = (succ(x) ⪠succ(y)) +â©Ï 4"
"arity(forces(Equal(x, y))) = (succ(x) ⪠succ(y)) +â©Ï 4"
unfolding forces_def
using assms arity_forces_mem_fm arity_forces_eq_fm succ_Un_distrib ord_simp_union
by (auto simp:FOL_arities,(rule_tac le_anti_sym,simp_all,(rule_tac not_le_anti_sym,simp_all))+)
lemma arity_forces':
assumes "Ïâformula"
shows "arity(forces'(Ï)) ⤠arity(Ï) +â©Ï 4"
using assms
proof (induct set:formula)
case (Member x y)
then
show ?case
using arity_forces_mem_fm succ_Un_distrib ord_simp_union leI not_le_iff_lt
by simp
next
case (Equal x y)
then
show ?case
using arity_forces_eq_fm succ_Un_distrib ord_simp_union leI not_le_iff_lt
by simp
next
case (Nand Ï Ï)
let ?Ï' = "ren_forces_nand(forces'(Ï))"
let ?Ï' = "ren_forces_nand(forces'(Ï))"
have "arity(is_leq_fm(3, 0, 1)) = 4"
using arity_is_leq_fm succ_Un_distrib ord_simp_union
by simp
have "3 ⤠(4+â©Ïarity(Ï)) ⪠(4+â©Ïarity(Ï))" (is "_ ⤠?rhs")
using ord_simp_union by simp
from â¹Ïâ_⺠Nand
have "pred(arity(?Ï')) ⤠?rhs" "pred(arity(?Ï')) ⤠?rhs"
proof -
from â¹Ïâ_⺠â¹Ïâ_âº
have A:"pred(arity(?Ï')) ⤠arity(forces'(Ï))"
"pred(arity(?Ï')) ⤠arity(forces'(Ï))"
using pred_mono[OF _ arity_ren_forces_nand] pred_succ_eq
by simp_all
from Nand
have "3 ⪠arity(forces'(Ï)) ⤠arity(Ï) +â©Ï 4"
"3 ⪠arity(forces'(Ï)) ⤠arity(Ï) +â©Ï 4"
using Un_le by simp_all
with Nand
show "pred(arity(?Ï')) ⤠?rhs"
"pred(arity(?Ï')) ⤠?rhs"
using le_trans[OF A(1)] le_trans[OF A(2)] le_Un_iff
by simp_all
qed
with Nand â¹_=4âº
show ?case
using pred_Un_distrib Un_assoc[symmetric] succ_Un_distrib union_abs1 Un_leI3[OF â¹3 ⤠?rhsâº]
by (simp add:FOL_arities)
next
case (Forall Ï)
let ?Ï' = "ren_forces_forall(forces'(Ï))"
show ?case
proof (cases "arity(Ï) = 0")
case True
with Forall
show ?thesis
proof -
from Forall True
have "arity(forces'(Ï)) ⤠5"
using le_trans[of _ 4 5] by auto
with â¹Ïâ_âº
have "arity(?Ï') ⤠5"
using arity_ren_forces_all[OF forces'_type[OF â¹Ïâ_âº]] union_abs2
by auto
with Forall True
show ?thesis
using pred_mono[OF _ â¹arity(?Ï') ⤠5âº]
by simp
qed
next
case False
with Forall
show ?thesis
proof -
from Forall False
have "arity(?Ï') = 5 ⪠arity(forces'(Ï))"
"arity(forces'(Ï)) ⤠5 +â©Ï arity(Ï)"
"4 ⤠3+â©Ïarity(Ï)"
using Ord_0_lt arity_ren_forces_all
le_trans[OF _ add_le_mono[of 4 5, OF _ le_refl]]
by auto
with â¹Ïâ_âº
have "5 ⪠arity(forces'(Ï)) ⤠5+â©Ïarity(Ï)"
using ord_simp_union by auto
with â¹Ïâ_⺠â¹arity(?Ï') = 5 ⪠_âº
show ?thesis
using pred_Un_distrib succ_pred_eq[OF _ â¹arity(Ï)â 0âº]
pred_mono[OF _ Forall(2)] Un_le[OF â¹4â¤3+â©Ïarity(Ï)âº]
by simp
qed
qed
qed
lemma arity_forces :
assumes "Ïâformula"
shows "arity(forces(Ï)) ⤠4+â©Ïarity(Ï)"
unfolding forces_def
using assms arity_forces' le_trans ord_simp_union FOL_arities by auto
lemma arity_forces_le :
assumes "Ïâformula" "nânat" "arity(Ï) ⤠n"
shows "arity(forces(Ï)) ⤠4+â©Ïn"
using assms le_trans[OF _ add_le_mono[OF le_refl[of 5] â¹arity(Ï)â¤_âº]] arity_forces
by auto
definition rename_split_fm where
"rename_split_fm(Ï) â¡ (â
â(â
â(â
â(â
â(â
â(â
ââ
â
snd(9) is 0â
â§ â
â
fst(9) is 4â
â§ â
â
1=11â
â§
â
â
2=12â
â§ â
â
3=13â
â§ â
â
5=7â
â§
(λp. incr_bv(p)`6)^8(forces(Ï)) â
â
â
â
â
â
â
)â
)â
)â
)â
)â
)"
lemma rename_split_fm_type[TC]: "Ïâformula â¹ rename_split_fm(Ï)âformula"
unfolding rename_split_fm_def by simp
schematic_goal arity_rename_split_fm: "Ïâformula â¹ arity(rename_split_fm(Ï)) = ?m"
using arity_forces[of Ï] forces_type unfolding rename_split_fm_def
by (simp add:arity Un_assoc[symmetric] union_abs1)
lemma arity_rename_split_fm_le:
assumes "Ïâformula"
shows "arity(rename_split_fm(Ï)) ⤠8 ⪠(6 +â©Ï arity(Ï))"
proof -
from assms
have arity_forces_6: "¬ 1 < arity(Ï) â¹ 6 ⤠n â¹ arity(forces(Ï)) ⤠n" for n
using le_trans lt_trans[of _ 5 n] not_lt_iff_le[of 1 "arity(Ï)"]
by (auto intro!:le_trans[OF arity_forces])
have pred1_arity_forces: "¬ 1 < arity(Ï) â¹ pred^n(arity(forces(Ï))) ⤠8" if "nânat" for n
using that pred_le[of 7] le_succ[THEN [2] le_trans] arity_forces_6
by (induct rule:nat_induct) auto
have arity_forces_le_succ6: "pred^n(arity(forces(Ï))) ⤠succ(succ(succ(succ(succ(succ(arity(Ï)))))))"
if "nânat" for n
using that assms arity_forces[of Ï, THEN le_trans,
OF _ le_succ, THEN le_trans, OF _ _ le_succ] le_trans[OF pred_le[OF _ le_succ]]
by (induct rule:nat_induct) auto
note trivial_arities = arity_forces_6
arity_forces_le_succ6[of 1, simplified] arity_forces_le_succ6[of 2, simplified]
arity_forces_le_succ6[of 3, simplified] arity_forces_le_succ6[of 4, simplified]
arity_forces_le_succ6[of 5, simplified] arity_forces_le_succ6[of 6, simplified]
pred1_arity_forces[of 1, simplified] pred1_arity_forces[of 2, simplified]
pred1_arity_forces[of 3, simplified] pred1_arity_forces[of 4, simplified]
pred1_arity_forces[of 5, simplified] pred1_arity_forces[of 6, simplified]
show ?thesis
using assms arity_forces[of Ï] arity_forces[of Ï, THEN le_trans, OF _ le_succ]
arity_forces[of Ï, THEN le_trans, OF _ le_succ, THEN le_trans, OF _ _ le_succ]
unfolding rename_split_fm_def
by (simp add:arity Un_assoc[symmetric] union_abs1 arity_forces[of Ï] forces_type)
((subst arity_incr_bv_lemma; auto simp: arity ord_simp_union forces_type trivial_arities)+)
qed
definition body_ground_repl_fm where
"body_ground_repl_fm(Ï) â¡ (â
â(â
ââ
is_Vset_fm(2, 0) â§ â
â
1 â 0â
â§ rename_split_fm(Ï) â
â
â
)â
)"
lemma body_ground_repl_fm_type[TC]: "Ïâformula â¹ body_ground_repl_fm(Ï)âformula"
unfolding body_ground_repl_fm_def by simp
lemma arity_body_ground_repl_fm_le:
notes le_trans[trans]
assumes "Ïâformula"
shows "arity(body_ground_repl_fm(Ï)) ⤠6 ⪠(arity(Ï) +â©Ï 4)"
proof -
from â¹Ïâformulaâº
have ineq: "n ⪠pred(pred(arity(rename_split_fm(Ï))))
⤠m ⪠pred(pred(8 ⪠(arity(Ï) +â©Ï6 )))" if "n ⤠m" "nânat" "mânat" for n m
using that arity_rename_split_fm_le[of Ï, THEN [2] pred_mono, THEN [2] pred_mono,
THEN [2] Un_mono[THEN subset_imp_le, OF _ le_imp_subset]] le_imp_subset
by auto
moreover
have eq1: "pred(pred(pred(4 ⪠2 ⪠pred(pred(pred(
pred(pred(pred(pred(pred(9 ⪠1 ⪠3 ⪠2))))))))))) = 1"
by (auto simp:pred_Un_distrib)
ultimately
have "pred(pred(pred(4 ⪠2 ⪠pred(pred(pred(
pred(pred(pred(pred(pred(9 ⪠1 ⪠3 ⪠2))))))))))) âª
pred(pred(arity(rename_split_fm(Ï)))) â¤
1 ⪠pred(pred(8 ⪠(arity(Ï) +â©Ï6 )))"
by auto
also from â¹Ïâformulaâº
have "1 ⪠pred(pred(8 ⪠(arity(Ï) +â©Ï6 ))) ⤠6 ⪠(4+â©Ïarity(Ï))"
by (auto simp:pred_Un_distrib Un_assoc[symmetric] ord_simp_union)
finally
show ?thesis
using â¹Ïâformula⺠unfolding body_ground_repl_fm_def
by (simp add:arity pred_Un_distrib, subst arity_transrec_fm[of "is_HVfrom_fm(8,2,1,0)" 3 1])
(simp add:arity pred_Un_distrib,simp_all,
auto simp add:eq1 arity_is_HVfrom_fm[of 8 2 1 0])
qed
definition ground_repl_fm where
"ground_repl_fm(Ï) â¡ least_fm(body_ground_repl_fm(Ï), 1)"
lemma ground_repl_fm_type[TC]:
"Ïâformula â¹ ground_repl_fm(Ï) â formula"
unfolding ground_repl_fm_def by simp
lemma arity_ground_repl_fm:
assumes "Ïâformula"
shows "arity(ground_repl_fm(Ï)) ⤠5 ⪠(3 +â©Ï arity(Ï))"
proof -
from assms
have "pred(arity(body_ground_repl_fm(Ï))) ⤠5 ⪠(3 +â©Ï arity(Ï))"
using arity_body_ground_repl_fm_le pred_mono succ_Un_distrib
by (rule_tac pred_le) auto
with assms
have "2 ⪠pred(arity(body_ground_repl_fm(Ï))) ⤠5 ⪠(3 +â©Ï arity(Ï))"
using Un_le le_Un_iff by auto
then
show ?thesis
using assms arity_forces arity_body_ground_repl_fm_le
unfolding least_fm_def ground_repl_fm_def
apply (auto simp add:arity Un_assoc[symmetric])
apply (simp add: pred_Un Un_assoc, simp add: Un_assoc[symmetric] union_abs1 pred_Un)
by(simp only: Un_commute, subst Un_commute, simp add:ord_simp_union,force)
qed
simple_rename "ren_F" src "[x_P, x_leq, x_o, x_f, y_c, x_bc, p, x, b]"
tgt "[x_bc, y_c,b,x, x_P, x_leq, x_o, x_f, p]"
simple_rename "ren_G" src "[x,x_P, x_leq, x_one, x_f,x_p,y,x_B]"
tgt "[x,y,x_P, x_leq, x_one, x_f,x_p,x_B]"
simple_rename "ren_F_aux" src "[q,x_P, x_leq, x_one, f_dot, x_a, x_bc,x_p,x_b]"
tgt "[x_bc, q, x_b, x_P, x_leq, x_one, f_dot,x_a,x_p]"
simple_rename "ren_G_aux" src "[ x_b, x_P, x_leq, x_one, f_dot,x_a,x_p,y]"
tgt "[ x_b, y, x_P, x_leq, x_one, f_dot,x_a,x_p]"
definition ccc_fun_closed_lemma_aux2_fm where [simp]:
"ccc_fun_closed_lemma_aux2_fm â¡ ren(Collect_fm(1, (â
ââ
â
2â§v5 is 0â
â§ ren(â
â
0â¼â2â7â
â§ forces(â
0`1 is 2â
) â
) ` 9 ` 9 ` ren_F_aux_fnâ
â
), 7)) ` 8 ` 8 ` ren_G_aux_fn"
lemma ccc_fun_closed_lemma_aux2_fm_type [TC] :
"ccc_fun_closed_lemma_aux2_fm â formula"
proof -
let ?Ï="â
â
0â¼â2â7â
â§ forces(â
0`1 is 2â
) â
"
let ?G="(â
ââ
â
2â§v5 is 0â
â§ ren(?Ï) ` 9 ` 9 ` ren_F_aux_fnâ
â
)"
have "ren(?Ï)`9`9`ren_F_aux_fn â formula"
using ren_tc ren_F_aux_thm check_fm_type is_leq_fm_type ren_F_aux_fn_def pred_le
by simp_all
then
show ?thesis
using ren_tc ren_G_aux_thm ren_G_aux_fn_def
by simp
qed
definition ccc_fun_closed_lemma_fm where [simp]:
"ccc_fun_closed_lemma_fm â¡ ren(Collect_fm(7, (â
ââ
â
2â§v5 is 0â
â§ (â
ââ
â
2â§v6 is 0â
â§
ren((â
ââ
â
0 â 1â
â§ â
â
0â¼â2â7â
â§ forces(â
0`1 is 2â
) â
â
â
)) ` 9 ` 9 ` ren_F_fnâ
â
)â
â
), 6))
` 8 ` 8 ` ren_G_fn"
lemma ccc_fun_closed_lemma_fm_type [TC] :
"ccc_fun_closed_lemma_fm â formula"
proof -
let ?Ï="(â
ââ
â
0 â 1â
â§ â
â
0 â¼â2â 7â
â§ forces(â
0`1 is 2â
) â
â
â
)"
let ?G="(â
ââ
â
2â§v5 is 0â
â§ (â
ââ
â
2â§v6 is 0â
â§ ren(?Ï) ` 9 ` 9 ` ren_F_fnâ
â
)â
â
)"
have "ren(?Ï)`9`9`ren_F_fn â formula"
using ren_tc ren_F_thm check_fm_type is_leq_fm_type ren_F_fn_def pred_le
by simp_all
then
show ?thesis
using ren_tc ren_G_thm ren_G_fn_def
by simp
qed
definition is_order_body
where "is_order_body(M,X,x,z) â¡ âA[M]. cartprod(M,X,X,A) â§ subset(M,x,A) â§ M(z) â§ M(x) â§
is_well_ord(M,X, x) â§ is_ordertype(M,X, x,z)"
synthesize "is_order_body" from_definition assuming "nonempty"
definition omap_wfrec_body where
"omap_wfrec_body(A,r) â¡ (â
ââ
image_fm(2, 0, 1) â§ pred_set_fm(9+â©ÏA, 3,9+â©Ïr, 0) â
â
)"
lemma type_omap_wfrec_body_fm :"Aânat â¹ rânat â¹ omap_wfrec_body(A,r)âformula"
unfolding omap_wfrec_body_def by simp
lemma arity_omap_wfrec_aux : "Aânat â¹ rânat â¹ arity(omap_wfrec_body(A,r)) = (9+â©ÏA) ⪠(9+â©Ïr)"
unfolding omap_wfrec_body_def
using arity_image_fm arity_pred_set_fm pred_Un_distrib union_abs2[of 3] union_abs1
by (simp add:FOL_arities, auto simp add:Un_assoc[symmetric] union_abs1)
lemma arity_omap_wfrec: "Aânat â¹ rânat â¹
arity(is_wfrec_fm(omap_wfrec_body(A,r),r+â©Ï3, 1, 0)) = (4+â©ÏA) ⪠(4+â©Ïr)"
using Arities.arity_is_wfrec_fm[OF _ _ _ _ _ arity_omap_wfrec_aux,of A r "3+â©Ïr" 1 0]
pred_Un_distrib union_abs1 union_abs2 type_omap_wfrec_body_fm
by auto
lemma arity_isordermap: "Aânat â¹ rânat â¹dânatâ¹
arity(is_ordermap_fm(A,r,d)) = succ(d) ⪠(succ(A) ⪠succ(r))"
unfolding is_ordermap_fm_def
using arity_lambda_fm[where i="(4+â©ÏA) ⪠(4+â©Ïr)",OF _ _ _ _ arity_omap_wfrec,
unfolded omap_wfrec_body_def] pred_Un_distrib union_abs1
by auto
lemma arity_is_ordertype: "Aânat â¹ rânat â¹dânatâ¹
arity(is_ordertype_fm(A,r,d)) = succ(d) ⪠(succ(A) ⪠succ(r))"
unfolding is_ordertype_fm_def
using arity_isordermap arity_image_fm pred_Un_distrib FOL_arities
by auto
arity_theorem for "is_order_body_fm"
lemma arity_is_order_body: "arity(is_order_body_fm(2,0,1)) = 3"
using arity_is_order_body_fm arity_is_ordertype ord_simp_union
by (simp add:FOL_arities)
definition H_order_pred where
"H_order_pred(A,r) ⡠λx f . f `` Order.pred(A, x, r)"
relationalize "H_order_pred" "is_H_order_pred"
synthesize "is_H_order_pred" from_definition assuming "nonempty"
definition order_pred_wfrec_body where
"order_pred_wfrec_body(M,A,r,z,x) â¡ ây[M].
pair(M, x, y, z) â§
(âf[M].
(âz[M].
z â f â·
(âxa[M].
ây[M].
âxaa[M].
âsx[M].
âr_sx[M].
âf_r_sx[M].
pair(M, xa, y, z) â§
pair(M, xa, x, xaa) â§
upair(M, xa, xa, sx) â§
pre_image(M, r, sx, r_sx) â§
restriction(M, f, r_sx, f_r_sx) â§
xaa â r â§ (âa[M]. image(M, f_r_sx, a, y) â§ pred_set(M, A, xa, r, a)))) â§
(âa[M]. image(M, f, a, y) â§ pred_set(M, A, x, r, a)))"
synthesize "order_pred_wfrec_body" from_definition
arity_theorem for "order_pred_wfrec_body_fm"
definition replacement_is_order_body_fm where "replacement_is_order_body_fm â¡ is_order_body_fm(2,0,1)"
definition wfrec_replacement_order_pred_fm where "wfrec_replacement_order_pred_fm â¡ order_pred_wfrec_body_fm(3,2,1,0)"
definition replacement_is_jump_cardinal_body_fm where "replacement_is_jump_cardinal_body_fm â¡ is_jump_cardinal_body'_fm(0,1)"
definition replacement_is_aleph_fm where "replacement_is_aleph_fm â¡ â
â
0 is ordinalâ
â§ â
âµ(0) is 1â
â
"
definition
funspace_succ_rep_intf where
"funspace_succ_rep_intf ⡠λp z n. âf b. p = <f,b> & z = {cons(<n,b>, f)}"
relativize functional "funspace_succ_rep_intf" "funspace_succ_rep_intf_rel"
relationalize "funspace_succ_rep_intf_rel" "is_funspace_succ_rep_intf"
synthesize "is_funspace_succ_rep_intf" from_definition
arity_theorem for "is_funspace_succ_rep_intf_fm"
definition
PHrank :: "[iâo,i,i,i] â o" where
"PHrank(M,f,y,z) â¡ (âfy[M]. fun_apply(M,f,y,fy) â§ successor(M,fy,z))"
synthesize "PHrank" from_definition assuming "nonempty"
definition wfrec_Hfrc_at_fm where "wfrec_Hfrc_at_fm â¡ (â
ââ
pair_fm(1, 0, 2) â§ is_wfrec_fm(Hfrc_at_fm(8, 9, 2, 1, 0), 5, 1, 0) â
â
)"
definition list_repl1_intf_fm where "list_repl1_intf_fm â¡ (â
ââ
pair_fm(1, 0, 2) â§ is_wfrec_fm(iterates_MH_fm(list_functor_fm(13, 1, 0), 10, 2, 1, 0), 3, 1, 0) â
â
)"
definition list_repl2_intf_fm where "list_repl2_intf_fm â¡ â
â
0 â 4â
â§ is_iterates_fm(list_functor_fm(13, 1, 0), 3, 0, 1) â
"
definition formula_repl2_intf_fm where "formula_repl2_intf_fm â¡ â
â
0 â 3â
â§ is_iterates_fm(formula_functor_fm(1, 0), 2, 0, 1) â
"
definition eclose_repl2_intf_fm where "eclose_repl2_intf_fm â¡ â
â
0 â 3â
â§ is_iterates_fm(â
â1 is 0â
, 2, 0, 1) â
"
definition powapply_repl_fm where "powapply_repl_fm â¡ is_Powapply_fm(2,0,1)"
definition phrank_repl_fm where "phrank_repl_fm â¡ PHrank_fm(2,0,1)"
definition wfrec_rank_fm where "wfrec_rank_fm â¡ (â
ââ
pair_fm(1, 0, 2) â§ is_wfrec_fm(is_Hrank_fm(2, 1, 0), 3, 1, 0) â
â
)"
definition trans_repl_HVFrom_fm where "trans_repl_HVFrom_fm â¡ (â
ââ
pair_fm(1, 0, 2) â§ is_wfrec_fm(is_HVfrom_fm(8, 2, 1, 0), 4, 1, 0) â
â
)"
definition wfrec_Hcheck_fm where "wfrec_Hcheck_fm â¡ (â
ââ
pair_fm(1, 0, 2) â§ is_wfrec_fm(is_Hcheck_fm(8, 2, 1, 0), 4, 1, 0) â
â
) "
definition repl_PHcheck_fm where "repl_PHcheck_fm â¡ PHcheck_fm(2,3,0,1)"
definition check_replacement_fm where "check_replacement_fm â¡ â
check_fm(0,2,1) â§ â
0 â 3â
â
"
definition G_dot_in_M_fm where "G_dot_in_M_fm â¡ â
(â
ââ
â
1â§v3 is 0â
â§ pair_fm(0, 1, 2) â
â
) â§ â
0 â 3â
â
"
definition repl_opname_check_fm where "repl_opname_check_fm â¡ â
is_opname_check_fm(3,2,0,1) â§ â
0 â 4â
â
"
definition tl_repl_intf_fm where "tl_repl_intf_fm â¡ (â
ââ
pair_fm(1, 0, 2) â§ is_wfrec_fm(iterates_MH_fm(tl_fm(1,0), 9, 2, 1, 0), 3, 1, 0) â
â
)"
definition formula_repl1_intf_fm where "formula_repl1_intf_fm â¡ (â
ââ
pair_fm(1, 0, 2) â§ is_wfrec_fm(iterates_MH_fm(formula_functor_fm(1,0), 9, 2, 1, 0), 3, 1, 0) â
â
)"
definition eclose_repl1_intf_fm where "eclose_repl1_intf_fm â¡ (â
ââ
pair_fm(1, 0, 2) â§ is_wfrec_fm(iterates_MH_fm(big_union_fm(1,0), 9, 2, 1, 0), 3, 1, 0) â
â
)"
definition replacement_assm where
"replacement_assm(M,env,Ï) â¡ Ï â formula â¶ env â list(M) â¶
arity(Ï) ⤠2 +â©Ï length(env) â¶
strong_replacement(##M,λx y. (M , [x,y]@env ⨠Ï))"
definition ground_replacement_assm where
"ground_replacement_assm(M,env,Ï) â¡ replacement_assm(M,env,ground_repl_fm(Ï))"
end
Theory Interface
sectionâ¹Interface between set models and Constructibilityâº
textâ¹This theory provides an interface between Paulson's
relativization results and set models of ZFC. In particular,
it is used to prove that the locale \<^term>â¹forcing_data⺠is
a sublocale of all relevant locales in \<^session>â¹ZF-Constructibleâº
(\<^term>â¹M_trivialâº, \<^term>â¹M_basicâº, \<^term>â¹M_ecloseâº, etc).
In order to interpret the locales in \<^session>â¹ZF-Constructible⺠we
introduce new locales, each stronger than the previous one, assuming
only the instances of Replacement needed to interpret the subsequent
locales of that session. From the start we assume Separation for
every internalized formula (with one parameter, but this is not a
problem since we can use pairing).âº
theory Interface
imports
Fm_Definitions
Transitive_Models.Cardinal_AC_Relative
Transitive_Models.M_Basic_No_Repl
begin
locale M_Z_basic =
fixes M
assumes
upair_ax: "upair_ax(##M)" and
Union_ax: "Union_ax(##M)" and
power_ax: "power_ax(##M)" and
extensionality:"extensionality(##M)" and
foundation_ax: "foundation_ax(##M)" and
infinity_ax: "infinity_ax(##M)" and
separation_ax: "Ï â formula â¹ env â list(M) â¹
arity(Ï) ⤠1 +â©Ï length(env) â¹
separation(##M,λx. (M, [x] @ env ⨠Ï))"
locale M_transset =
fixes M
assumes
trans_M: "Transset(M)"
locale M_Z_trans = M_Z_basic + M_transset
locale M_ZF1 = M_Z_basic +
assumes
replacement_ax1:
"replacement_assm(M,env,wfrec_Hfrc_at_fm)"
"replacement_assm(M,env,list_repl1_intf_fm)"
"replacement_assm(M,env,list_repl2_intf_fm)"
"replacement_assm(M,env,formula_repl2_intf_fm)"
"replacement_assm(M,env,eclose_repl2_intf_fm)"
"replacement_assm(M,env,powapply_repl_fm)"
"replacement_assm(M,env,phrank_repl_fm)"
"replacement_assm(M,env,wfrec_rank_fm)"
"replacement_assm(M,env,trans_repl_HVFrom_fm)"
"replacement_assm(M,env,wfrec_Hcheck_fm)"
"replacement_assm(M,env,repl_PHcheck_fm)"
"replacement_assm(M,env,check_replacement_fm)"
"replacement_assm(M,env,G_dot_in_M_fm)"
"replacement_assm(M,env,repl_opname_check_fm)"
"replacement_assm(M,env,tl_repl_intf_fm)"
"replacement_assm(M,env,formula_repl1_intf_fm)"
"replacement_assm(M,env,eclose_repl1_intf_fm)"
definition instances1_fms where "instances1_fms â¡
{ wfrec_Hfrc_at_fm,
list_repl1_intf_fm,
list_repl2_intf_fm,
formula_repl2_intf_fm,
eclose_repl2_intf_fm,
powapply_repl_fm,
phrank_repl_fm,
wfrec_rank_fm,
trans_repl_HVFrom_fm,
wfrec_Hcheck_fm,
repl_PHcheck_fm,
check_replacement_fm,
G_dot_in_M_fm,
repl_opname_check_fm,
tl_repl_intf_fm,
formula_repl1_intf_fm,
eclose_repl1_intf_fm }"
txtâ¹This set has 17 internalized formulas.âº
lemmas replacement_instances1_defs = tl_repl_intf_fm_def formula_repl1_intf_fm_def
eclose_repl1_intf_fm_def wfrec_Hfrc_at_fm_def
list_repl1_intf_fm_def list_repl2_intf_fm_def formula_repl2_intf_fm_def
eclose_repl2_intf_fm_def powapply_repl_fm_def phrank_repl_fm_def wfrec_rank_fm_def
trans_repl_HVFrom_fm_def wfrec_Hcheck_fm_def repl_PHcheck_fm_def check_replacement_fm_def
G_dot_in_M_fm_def repl_opname_check_fm_def
lemma instances1_fms_type[TC]: "instances1_fms â formula"
unfolding replacement_instances1_defs instances1_fms_def by simp
declare (in M_ZF1) replacement_instances1_defs[simp]
locale M_ZF1_trans = M_ZF1 + M_Z_trans
context M_Z_trans
begin
lemmas transitivity = Transset_intf[OF trans_M]
subsectionâ¹Interface with \<^term>â¹M_trivialâºâº
lemma zero_in_M: "0 â M"
proof -
obtain z where "empty(##M,z)" "zâM"
using empty_intf[OF infinity_ax]
by auto
moreover from this
have "z=0"
using transitivity empty_def
by auto
ultimately
show ?thesis
by simp
qed
lemma separation_in_ctm :
assumes
"Ï â formula" "envâlist(M)"
"arity(Ï) ⤠1 +â©Ï length(env)" and
satsQ: "âx. xâM â¹ (M, [x]@env ⨠Ï) â· Q(x)"
shows
"separation(##M,Q)"
using assms separation_ax satsQ transitivity
separation_cong[of "##M" "λy. (M, [y]@env ⨠Ï)" "Q"]
by simp
end
locale M_ZC_basic = M_Z_basic + M_AC "##M"
locale M_ZFC1 = M_ZF1 + M_ZC_basic
locale M_ZFC1_trans = M_ZF1_trans + M_ZFC1
sublocale M_Z_trans â M_trans "##M"
using transitivity zero_in_M exI[of "λx. xâM"]
by unfold_locales simp_all
sublocale M_Z_trans â M_trivial "##M"
using upair_ax Union_ax by unfold_locales
subsectionâ¹Interface with \<^term>â¹M_basicâºâº
definition Intersection where
"Intersection(N,B,x) â¡ (ây[N]. yâB â¶ xây)"
synthesize "Intersection" from_definition "Intersection" assuming "nonempty"
arity_theorem for "Intersection_fm"
definition CartProd where
"CartProd(N,B,C,z) â¡ (âx[N]. xâB â§ (ây[N]. yâC â§ pair(N,x,y,z)))"
synthesize "CartProd" from_definition "CartProd" assuming "nonempty"
arity_theorem for "CartProd_fm"
definition Image where
"Image(N,B,r,y) â¡ (âp[N]. pâr â§ (âx[N]. xâB â§ pair(N,x,y,p)))"
synthesize "Image" from_definition "Image" assuming "nonempty"
arity_theorem for "Image_fm"
definition Converse where
"Converse(N,R,z) â¡ âp[N]. pâR â§ (âx[N].ây[N]. pair(N,x,y,p) â§ pair(N,y,x,z))"
synthesize "Converse" from_definition "Converse" assuming "nonempty"
arity_theorem for "Converse_fm"
definition Restrict where
"Restrict(N,A,z) â¡ âx[N]. xâA â§ (ây[N]. pair(N,x,y,z))"
synthesize "Restrict" from_definition "Restrict" assuming "nonempty"
arity_theorem for "Restrict_fm"
definition Comp where
"Comp(N,R,S,xz) â¡ âx[N]. ây[N]. âz[N]. âxy[N]. âyz[N].
pair(N,x,z,xz) â§ pair(N,x,y,xy) â§ pair(N,y,z,yz) â§ xyâS â§ yzâR"
synthesize "Comp" from_definition "Comp" assuming "nonempty"
arity_theorem for "Comp_fm"
definition Pred where
"Pred(N,R,X,y) â¡ âp[N]. pâR â§ pair(N,y,X,p)"
synthesize "Pred" from_definition "Pred" assuming "nonempty"
arity_theorem for "Pred_fm"
definition is_Memrel where
"is_Memrel(N,z) â¡ âx[N]. ây[N]. pair(N,x,y,z) â§ x â y"
synthesize "is_Memrel" from_definition "is_Memrel" assuming "nonempty"
arity_theorem for "is_Memrel_fm"
definition RecFun where
"RecFun(N,r,f,g,a,b,x) â¡ âxa[N]. âxb[N].
pair(N,x,a,xa) â§ xa â r â§ pair(N,x,b,xb) â§ xb â r â§
(âfx[N]. âgx[N]. fun_apply(N,f,x,fx) â§ fun_apply(N,g,x,gx) â§
fx â gx)"
synthesize "RecFun" from_definition "RecFun" assuming "nonempty"
arity_theorem for "RecFun_fm"
arity_theorem for "rtran_closure_mem_fm"
synthesize "wellfounded_trancl" from_definition assuming "nonempty"
arity_theorem for "wellfounded_trancl_fm"
context M_Z_trans
begin
lemma inter_sep_intf :
assumes "AâM"
shows "separation(##M,λx . âyâM . yâA â¶ xây)"
using assms separation_in_ctm[of "Intersection_fm(1,0)" "[A]" "Intersection(##M,A)"]
Intersection_iff_sats[of 1 "[_,A]" A 0 _ M] arity_Intersection_fm Intersection_fm_type
ord_simp_union zero_in_M
unfolding Intersection_def
by simp
lemma diff_sep_intf :
assumes "BâM"
shows "separation(##M,λx . xâB)"
using assms separation_in_ctm[of "Neg(Member(0,1))" "[B]" "λx . xâB"] ord_simp_union
by simp
lemma cartprod_sep_intf :
assumes "AâM" and "BâM"
shows "separation(##M,λz. âxâM. xâA â§ (âyâM. yâB â§ pair(##M,x,y,z)))"
using assms separation_in_ctm[of "CartProd_fm(1,2,0)" "[A,B]" "CartProd(##M,A,B)"]
CartProd_iff_sats[of 1 "[_,A,B]" A 2 B 0 _ M] arity_CartProd_fm CartProd_fm_type
ord_simp_union zero_in_M
unfolding CartProd_def
by simp
lemma image_sep_intf :
assumes "AâM" and "BâM"
shows "separation(##M, λy. âpâM. pâB â§ (âxâM. xâA â§ pair(##M,x,y,p)))"
using assms separation_in_ctm[of "Image_fm(1,2,0)" "[A,B]" "Image(##M,A,B)"]
Image_iff_sats[of 1 "[_,A,B]" _ 2 _ 0 _ M] arity_Image_fm Image_fm_type
ord_simp_union zero_in_M
unfolding Image_def
by simp
lemma converse_sep_intf :
assumes "RâM"
shows "separation(##M,λz. âpâM. pâR â§ (âxâM.âyâM. pair(##M,x,y,p) â§ pair(##M,y,x,z)))"
using assms separation_in_ctm[of "Converse_fm(1,0)" "[R]" "Converse(##M,R)"]
Converse_iff_sats[of 1 "[_,R]" _ 0 _ M] arity_Converse_fm Converse_fm_type
ord_simp_union zero_in_M
unfolding Converse_def
by simp
lemma restrict_sep_intf :
assumes "AâM"
shows "separation(##M,λz. âxâM. xâA â§ (âyâM. pair(##M,x,y,z)))"
using assms separation_in_ctm[of "Restrict_fm(1,0)" "[A]" "Restrict(##M,A)"]
Restrict_iff_sats[of 1 "[_,A]" _ 0 _ M] arity_Restrict_fm Restrict_fm_type
ord_simp_union zero_in_M
unfolding Restrict_def
by simp
lemma comp_sep_intf :
assumes "RâM" and "SâM"
shows "separation(##M,λxz. âxâM. âyâM. âzâM. âxyâM. âyzâM.
pair(##M,x,z,xz) â§ pair(##M,x,y,xy) â§ pair(##M,y,z,yz) â§ xyâS â§ yzâR)"
using assms separation_in_ctm[of "Comp_fm(1,2,0)" "[R,S]" "Comp(##M,R,S)"]
Comp_iff_sats[of 1 "[_,R,S]" _ 2 _ 0 _ M] arity_Comp_fm Comp_fm_type
ord_simp_union zero_in_M
unfolding Comp_def
by simp
lemma pred_sep_intf:
assumes "RâM" and "XâM"
shows "separation(##M, λy. âpâM. pâR â§ pair(##M,y,X,p))"
using assms separation_in_ctm[of "Pred_fm(1,2,0)" "[R,X]" "Pred(##M,R,X)"]
Pred_iff_sats[of 1 "[_,R,X]" _ 2 _ 0 _ M] arity_Pred_fm Pred_fm_type
ord_simp_union zero_in_M
unfolding Pred_def
by simp
lemma memrel_sep_intf:
"separation(##M, λz. âxâM. âyâM. pair(##M,x,y,z) â§ x â y)"
using separation_in_ctm[of "is_Memrel_fm(0)" "[]" "is_Memrel(##M)"]
is_Memrel_iff_sats[of 0 "[_]" _ M] arity_is_Memrel_fm is_Memrel_fm_type
ord_simp_union zero_in_M
unfolding is_Memrel_def
by simp
lemma is_recfun_sep_intf :
assumes "râM" "fâM" "gâM" "aâM" "bâM"
shows "separation(##M,λx. âxaâM. âxbâM.
pair(##M,x,a,xa) â§ xa â r â§ pair(##M,x,b,xb) â§ xb â r â§
(âfxâM. âgxâM. fun_apply(##M,f,x,fx) â§ fun_apply(##M,g,x,gx) â§
fx â gx))"
using assms separation_in_ctm[of "RecFun_fm(1,2,3,4,5,0)" "[r,f,g,a,b]" "RecFun(##M,r,f,g,a,b)"]
RecFun_iff_sats[of 1 "[_,r,f,g,a,b]" _ 2 _ 3 _ 4 _ 5 _ 0 _ M] arity_RecFun_fm RecFun_fm_type
ord_simp_union zero_in_M
unfolding RecFun_def
by simp
lemmas M_basic_sep_instances =
inter_sep_intf diff_sep_intf cartprod_sep_intf
image_sep_intf converse_sep_intf restrict_sep_intf
pred_sep_intf memrel_sep_intf comp_sep_intf is_recfun_sep_intf
end
sublocale M_Z_trans â M_basic_no_repl "##M"
using power_ax M_basic_sep_instances
by unfold_locales simp_all
lemma Replace_eq_Collect:
assumes "âx y y'. xâA â¹ P(x,y) â¹ P(x,y') â¹ y=y'" "{y . x â A, P(x, y)} â B"
shows "{y . x â A, P(x, y)} = {yâB . âxâA. P(x,y)}"
using assms by blast
context M_Z_trans
begin
lemma Pow_inter_M_closed: assumes "A â M" shows "Pow(A) â© M â M"
proof -
have "{a â Pow(A) . a â M} = Pow(A) â© M" by auto
then
show ?thesis
using power_ax powerset_abs assms unfolding power_ax_def
by auto
qed
lemma Pow'_inter_M_closed: assumes "A â M" shows "{a â Pow(A) . a â M} â M"
using power_ax powerset_abs assms unfolding power_ax_def by auto
end
context M_basic_no_repl
begin
lemma Replace_funspace_succ_rep_intf_sub:
assumes
"M(A)" "M(n)"
shows
"{z . p â A, funspace_succ_rep_intf_rel(M,p,z,n)}
â PowâMâ(PowâMâ(âdomain(A) ⪠({n} à range(A)) ⪠(â({n} à range(A)))))"
unfolding funspace_succ_rep_intf_rel_def using assms mem_Pow_rel_abs
by clarsimp (auto simp: cartprod_def)
lemma funspace_succ_rep_intf_uniq:
assumes
"funspace_succ_rep_intf_rel(M,p,z,n)" "funspace_succ_rep_intf_rel(M,p,z',n)"
shows
"z = z'"
using assms unfolding funspace_succ_rep_intf_rel_def by auto
lemma Replace_funspace_succ_rep_intf_eq:
assumes
"M(A)" "M(n)"
shows
"{z . p â A, funspace_succ_rep_intf_rel(M,p,z,n)} =
{z â PowâMâ(PowâMâ(âdomain(A) ⪠({n} à range(A)) ⪠(â({n} à range(A))))) .
âpâA. funspace_succ_rep_intf_rel(M,p,z,n)}"
using assms Replace_eq_Collect[OF funspace_succ_rep_intf_uniq, of A,
OF _ _ Replace_funspace_succ_rep_intf_sub[of A n], of "λx y z. x" "λx y z. n"]
by (intro equalityI)
(auto dest:transM simp:funspace_succ_rep_intf_rel_def)
end
definition fsri where
"fsri(N,A,B) ⡠λz. âpâA. âf[N]. âb[N]. p = â¨f, bâ© â§ z = {cons(â¨B, bâ©, f)}"
relationalize "fsri" "is_fsri"
synthesize "is_fsri" from_definition assuming "nonempty"
arity_theorem for "is_fsri_fm"
context M_Z_trans
begin
lemma separation_fsri:
"(##M)(A) â¹ (##M)(B) â¹ separation(##M, is_fsri(##M,A,B))"
using separation_in_ctm[where env="[A,B]" and Ï="is_fsri_fm(1,2,0)"]
zero_in_M is_fsri_iff_sats[symmetric] arity_is_fsri_fm is_fsri_fm_type
by (simp_all add: ord_simp_union)
lemma separation_funspace_succ_rep_intf_rel:
"(##M)(A) â¹ (##M)(B) â¹ separation(##M, λz. âpâA. funspace_succ_rep_intf_rel(##M,p,z,B))"
using separation_fsri zero_in_M
by (rule_tac separation_cong[THEN iffD1, of _ "is_fsri(##M,A,B)"])
(auto simp flip:setclass_iff dest:transM
simp:is_fsri_def funspace_succ_rep_intf_rel_def, force)
lemma Replace_funspace_succ_rep_intf_in_M:
assumes
"A â M" "n â M"
shows
"{z . p â A, funspace_succ_rep_intf_rel(##M,p,z,n)} â M"
proof -
have "(##M)({z â PowâMâ(PowâMâ(âdomain(A) ⪠({n} à range(A)) ⪠(â({n} à range(A))))) .
âpâA. funspace_succ_rep_intf_rel(##M,p,z,n)})"
using assms separation_funspace_succ_rep_intf_rel
by (intro separation_closed) (auto simp flip:setclass_iff)
with assms
show ?thesis
using Replace_funspace_succ_rep_intf_eq by auto
qed
lemma funspace_succ_rep_intf:
assumes "nâM"
shows
"strong_replacement(##M,
λp z. âfâM. âbâM. ânbâM. âcnbfâM.
pair(##M,f,b,p) â§ pair(##M,n,b,nb) â§ is_cons(##M,nb,f,cnbf) â§
upair(##M,cnbf,cnbf,z))"
using assms
unfolding strong_replacement_def univalent_def
apply (simp add:pair_in_M_iff[simplified])
apply clarsimp
apply (rule_tac x="{z . p â A, funspace_succ_rep_intf_rel(##M,p,z,n)}" in bexI)
apply (auto simp:funspace_succ_rep_intf_rel_def
Replace_funspace_succ_rep_intf_in_M[unfolded funspace_succ_rep_intf_rel_def, simplified])
apply (rule_tac x="â¨f, baâ©" in bexI)
apply (auto dest:transM simp:pair_in_M_iff[simplified] cons_closed[simplified])
done
end
sublocale M_Z_trans â M_basic "##M"
using power_ax M_basic_sep_instances funspace_succ_rep_intf
by unfold_locales auto
subsectionâ¹Interface with \<^term>â¹M_tranclâºâº
lemma (in M_ZF1_trans) rtrancl_separation_intf:
assumes "râM" "AâM"
shows "separation (##M, rtran_closure_mem(##M,A,r))"
using assms separation_in_ctm[of "rtran_closure_mem_fm(1,2,0)" "[A,r]" "rtran_closure_mem(##M,A,r)"]
arity_rtran_closure_mem_fm ord_simp_union zero_in_M
by simp
context M_ZF1_trans
begin
lemma wftrancl_separation_intf:
assumes "râM" and "ZâM"
shows "separation (##M, wellfounded_trancl(##M,Z,r))"
using assms separation_in_ctm[of "wellfounded_trancl_fm(1,2,0)" "[Z,r]" "wellfounded_trancl(##M,Z,r)"]
arity_wellfounded_trancl_fm ord_simp_union zero_in_M
by simp
textâ¹To prove \<^term>â¹nat â M⺠we get an infinite set \<^term>â¹I⺠from \<^term>â¹infinity_axâº
closed under \<^term>â¹0⺠and \<^term>â¹succâº; that shows \<^term>â¹natâIâº. Then we
can separate \<^term>â¹I⺠with the predicate \<^term>â¹Î»x. xânatâº.âº
lemma finite_sep_intf: "separation(##M, λx. xânat)"
proof -
have "(âvâM. separation(##M,λx. (M, [x,v] ⨠finite_ordinal_fm(0))))"
using separation_ax arity_finite_ordinal_fm
by simp
then
have "(âvâM. separation(##M,finite_ordinal(##M)))"
unfolding separation_def
by simp
then
have "separation(##M,finite_ordinal(##M))"
using separation_in_ctm zero_in_M
by auto
then
show ?thesis
unfolding separation_def
by simp
qed
lemma nat_subset_I: "âIâM. nat â I"
proof -
have "nat â I"
if "IâM" and "0âI" and "âx. xâI â¹ succ(x)âI" for I
using that
by (rule_tac subsetI,induct_tac x,simp_all)
moreover
obtain I where
"IâM" "0âI" "âx. xâI â¹ succ(x)âI"
using infinity_ax transitivity
unfolding infinity_ax_def
by auto
ultimately
show ?thesis
by auto
qed
lemma nat_in_M: "nat â M"
proof -
have "{xâB . xâA}=A" if "AâB" for A B
using that by auto
moreover
obtain I where
"IâM" "natâI"
using nat_subset_I by auto
moreover from this
have "{xâI . xânat} â M"
using finite_sep_intf separation_closed[of "λx . xânat"]
by simp
ultimately
show ?thesis
by simp
qed
end
sublocale M_ZF1_trans â M_trancl "##M"
using rtrancl_separation_intf wftrancl_separation_intf nat_in_M
wellfounded_trancl_def
by unfold_locales auto
subsectionâ¹Interface with \<^term>â¹M_ecloseâºâº
lemma repl_sats:
assumes
sat:"âx z. xâM â¹ zâM â¹ (M, Cons(x,Cons(z,env)) ⨠Ï) â· P(x,z)"
shows
"strong_replacement(##M,λx z. (M, Cons(x,Cons(z,env)) ⨠Ï)) â·
strong_replacement(##M,P)"
by (rule strong_replacement_cong,simp add:sat)
arity_theorem for "list_functor_fm"
lemma (in M_ZF1_trans) list_repl1_intf:
assumes "AâM"
shows "iterates_replacement(##M, is_list_functor(##M,A), 0)"
proof -
let ?f="Exists(And(pair_fm(1,0,2),
is_wfrec_fm(iterates_MH_fm(list_functor_fm(13,1,0),10,2,1,0),3,1,0)))"
have "arity(?f) = 5"
using arity_iterates_MH_fm[where isF="list_functor_fm(13,1,0)" and i=14]
arity_wfrec_replacement_fm[where i=11] arity_list_functor_fm ord_simp_union
by simp
{
fix n
assume "nânat"
then
have "Memrel(succ(n))âM"
using nat_into_M Memrel_closed
by simp
moreover
note assms zero_in_M
moreover from calculation
have "is_list_functor(##M, A, a, b)
ⷠ(M, [b,a,c,d,a0,a1,a2,a3,a4,y,x,z,Memrel(succ(n)),A,0] ⨠list_functor_fm(13,1,0))"
if "aâM" "bâM" "câM" "dâM" "a0âM" "a1âM" "a2âM" "a3âM" "a4âM" "yâM" "xâM" "zâM"
for a b c d a0 a1 a2 a3 a4 y x z
using that
by simp
moreover from calculation
have "(M, [a0,a1,a2,a3,a4,y,x,z,Memrel(succ(n)),A,0] â¨
iterates_MH_fm(list_functor_fm(13,1,0),10,2,1,0)) â·
iterates_MH(##M,is_list_functor(##M,A),0,a2, a1, a0)"
if "a0âM" "a1âM" "a2âM" "a3âM" "a4âM" "yâM" "xâM" "zâM"
for a0 a1 a2 a3 a4 y x z
using that sats_iterates_MH_fm[of M "is_list_functor(##M,A)" _]
by simp
moreover from calculation
have "(M, [y,x,z,Memrel(succ(n)),A,0] â¨
is_wfrec_fm(iterates_MH_fm(list_functor_fm(13,1,0),10,2,1,0),3,1,0)) â·
is_wfrec(##M, iterates_MH(##M,is_list_functor(##M,A),0) , Memrel(succ(n)), x, y)"
if "yâM" "xâM" "zâM" for y x z
using that sats_is_wfrec_fm
by simp
moreover from calculation
have "(M, [x,z,Memrel(succ(n)),A,0] ⨠?f) â·
(âyâM. pair(##M,x,y,z) â§
is_wfrec(##M, iterates_MH(##M,is_list_functor(##M,A),0) , Memrel(succ(n)), x, y))"
if "xâM" "zâM" for x z
using that
by (simp del:pair_abs)
moreover
note â¹arity(?f) = 5âº
moreover from calculation
have "strong_replacement(##M,λx z. (M, [x,z,Memrel(succ(n)),A,0] ⨠?f))"
using replacement_ax1(2)[unfolded replacement_assm_def]
by simp
moreover from calculation
have "strong_replacement(##M,λx z.
âyâM. pair(##M,x,y,z) â§ is_wfrec(##M, iterates_MH(##M,is_list_functor(##M,A),0) ,
Memrel(succ(n)), x, y))"
using repl_sats[of M ?f "[Memrel(succ(n)),A,0]"]
by (simp del:pair_abs)
}
then
show ?thesis
unfolding iterates_replacement_def wfrec_replacement_def
by simp
qed
textâ¹This lemma obtains \<^term>â¹iterates_replacement⺠for predicates
without parameters.âº
lemma (in M_ZF1_trans) iterates_repl_intf :
assumes
"vâM" and
isfm:"is_F_fm â formula" and
arty:"arity(is_F_fm)=2" and
satsf: "âa b env'. ⦠aâM ; bâM ; env'âlist(M) â§
⹠is_F(a,b) ⷠ(M, [b,a]@env' ⨠is_F_fm)"
and is_F_fm_replacement:
"âenv. (â
ââ
â
â¨1,0â© is 2â
â§ is_wfrec_fm(iterates_MH_fm(is_F_fm,9,2,1,0),3,1,0) â
â
) â formula â¹ env â list(M) â¹
arity((â
ââ
â
â¨1,0â© is 2â
â§ is_wfrec_fm(iterates_MH_fm(is_F_fm,9,2,1,0),3,1,0) â
â
)) ⤠2 +â©Ï length(env) â¹
strong_replacement(##M,λx y.
M, [x,y] @ env ⨠(â
ââ
â
â¨1,0â© is 2â
â§ is_wfrec_fm(iterates_MH_fm(is_F_fm,9,2,1,0),3,1,0) â
â
))"
shows
"iterates_replacement(##M,is_F,v)"
proof -
let ?f="(â
ââ
â
â¨1,0â© is 2â
â§ is_wfrec_fm(iterates_MH_fm(is_F_fm,9,2,1,0),3,1,0) â
â
)"
have "arity(?f) = 4" "?fâformula"
using arity_iterates_MH_fm[where isF=is_F_fm and i=2]
arity_wfrec_replacement_fm[where i=10] isfm arty ord_simp_union
by simp_all
{
fix n
assume "nânat"
then
have "Memrel(succ(n))âM"
using nat_into_M Memrel_closed
by simp
moreover
{
fix a0 a1 a2 a3 a4 y x z
assume "[a0,a1,a2,a3,a4,y,x,z]âlist(M)"
moreover
note â¹vâM⺠â¹Memrel(succ(n))âMâº
moreover from calculation
have "(M, [b,a,c,d,a0,a1,a2,a3,a4,y,x,z,Memrel(succ(n)),v] ⨠is_F_fm) â·
is_F(a,b)"
if "aâM" "bâM" "câM" "dâM" for a b c d
using that satsf[of a b "[c,d,a0,a1,a2,a3,a4,y,x,z,Memrel(succ(n)),v]"]
by simp
moreover from calculation
have "(M, [a0,a1,a2,a3,a4,y,x,z,Memrel(succ(n)),v] ⨠iterates_MH_fm(is_F_fm,9,2,1,0)) â·
iterates_MH(##M,is_F,v,a2, a1, a0)"
using sats_iterates_MH_fm[of M "is_F" "is_F_fm"]
by simp
}
moreover from calculation
have "(M, [y,x,z,Memrel(succ(n)),v] ⨠is_wfrec_fm(iterates_MH_fm(is_F_fm,9,2,1,0),3,1,0)) â·
is_wfrec(##M, iterates_MH(##M,is_F,v),Memrel(succ(n)), x, y)"
if "yâM" "xâM" "zâM" for y x z
using that sats_is_wfrec_fm â¹vâM⺠by simp
moreover from calculation
have "(M, [x,z,Memrel(succ(n)),v] ⨠?f) â·
(âyâM. pair(##M,x,y,z) â§
is_wfrec(##M, iterates_MH(##M,is_F,v) , Memrel(succ(n)), x, y))"
if "xâM" "zâM" for x z
using that â¹vâMâº
by (simp del:pair_abs)
moreover
note â¹arity(?f) = 4⺠â¹?fâformulaâº
moreover from calculation â¹vâ_âº
have "strong_replacement(##M,λx z. (M, [x,z,Memrel(succ(n)),v] ⨠?f))"
using is_F_fm_replacement
by simp
ultimately
have "strong_replacement(##M,λx z.
âyâM. pair(##M,x,y,z) â§ is_wfrec(##M, iterates_MH(##M,is_F,v) ,
Memrel(succ(n)), x, y))"
using repl_sats[of M ?f "[Memrel(succ(n)),v]"]
by (simp del:pair_abs)
}
then
show ?thesis
unfolding iterates_replacement_def wfrec_replacement_def
by simp
qed
arity_theorem for "formula_functor_fm"
lemma (in M_ZF1_trans) formula_repl1_intf :
"iterates_replacement(##M, is_formula_functor(##M), 0)"
using arity_formula_functor_fm zero_in_M ord_simp_union
iterates_repl_intf[where is_F_fm="formula_functor_fm(1,0)"]
replacement_ax1(16)[unfolded replacement_assm_def]
by simp
arity_theorem for "Inl_fm"
arity_theorem for "Inr_fm"
arity_theorem for "Nil_fm"
arity_theorem for "Cons_fm"
arity_theorem for "quasilist_fm"
arity_theorem for "tl_fm"
lemma (in M_ZF1_trans) tl_repl_intf:
assumes "l â M"
shows "iterates_replacement(##M,λl' t. is_tl(##M,l',t),l)"
using assms arity_tl_fm ord_simp_union
iterates_repl_intf[where is_F_fm="tl_fm(1,0)"]
replacement_ax1(15)[unfolded replacement_assm_def]
by simp
arity_theorem for "big_union_fm"
lemma (in M_ZF1_trans) eclose_repl1_intf:
assumes "AâM"
shows "iterates_replacement(##M, big_union(##M), A)"
using assms arity_big_union_fm
iterates_repl_intf[where is_F_fm="big_union_fm(1,0)"]
replacement_ax1(17)[unfolded replacement_assm_def]
ord_simp_union
by simp
lemma (in M_ZF1_trans) list_repl2_intf:
assumes "AâM"
shows "strong_replacement(##M,λn y. nânat â§
is_iterates(##M, is_list_functor(##M,A), 0, n, y))"
proof -
let ?f = "And(Member(0,4),is_iterates_fm(list_functor_fm(13,1,0),3,0,1))"
note zero_in_M nat_in_M â¹AâMâº
moreover from this
have "is_list_functor(##M,A,a,b) â·
(M, [b,a,c,d,e,f,g,h,i,j,k,n,y,A,0,nat] ⨠list_functor_fm(13,1,0))"
if "aâM" "bâM" "câM" "dâM" "eâM" "fâM""gâM""hâM""iâM""jâM" "kâM" "nâM" "yâM"
for a b c d e f g h i j k n y
using that
by simp
moreover from calculation
have "(M, [n,y,A,0,nat] ⨠is_iterates_fm(list_functor_fm(13,1,0),3,0,1)) â·
is_iterates(##M, is_list_functor(##M,A), 0, n , y)"
if "nâM" "yâM" for n y
using that sats_is_iterates_fm[of M "is_list_functor(##M,A)"]
by simp
moreover from calculation
have "(M, [n,y,A,0,nat] ⨠?f) â·
nânat â§ is_iterates(##M, is_list_functor(##M,A), 0, n, y)"
if "nâM" "yâM" for n y
using that
by simp
moreover
have "arity(?f) = 5"
using arity_is_iterates_fm[where p="list_functor_fm(13,1,0)" and i=14]
arity_list_functor_fm arity_And ord_simp_union
by simp
ultimately
show ?thesis
using replacement_ax1(3)[unfolded replacement_assm_def] repl_sats[of M ?f "[A,0,nat]"]
by simp
qed
lemma (in M_ZF1_trans) formula_repl2_intf:
"strong_replacement(##M,λn y. nânat â§ is_iterates(##M, is_formula_functor(##M), 0, n, y))"
proof -
let ?f = "And(Member(0,3),is_iterates_fm(formula_functor_fm(1,0),2,0,1))"
note zero_in_M nat_in_M
moreover from this
have "is_formula_functor(##M,a,b) â·
(M, [b,a,c,d,e,f,g,h,i,j,k,n,y,0,nat] ⨠formula_functor_fm(1,0))"
if "aâM" "bâM" "câM" "dâM" "eâM" "fâM""gâM""hâM""iâM""jâM" "kâM" "nâM" "yâM"
for a b c d e f g h i j k n y
using that
by simp
moreover from calculation
have "(M, [n,y,0,nat] ⨠is_iterates_fm(formula_functor_fm(1,0),2,0,1)) â·
is_iterates(##M, is_formula_functor(##M), 0, n , y)"
if "nâM" "yâM" for n y
using that sats_is_iterates_fm[of M "is_formula_functor(##M)"]
by simp
moreover from calculation
have "(M, [n,y,0,nat] ⨠?f) â·
nânat â§ is_iterates(##M, is_formula_functor(##M), 0, n, y)"
if "nâM" "yâM" for n y
using that
by simp
moreover
have "arity(?f) = 4"
using arity_is_iterates_fm[where p="formula_functor_fm(1,0)" and i=2]
arity_formula_functor_fm arity_And ord_simp_union
by simp
ultimately
show ?thesis
using replacement_ax1(4)[unfolded replacement_assm_def] repl_sats[of M ?f "[0,nat]"]
by simp
qed
lemma (in M_ZF1_trans) eclose_repl2_intf:
assumes "AâM"
shows "strong_replacement(##M,λn y. nânat â§ is_iterates(##M, big_union(##M), A, n, y))"
proof -
let ?f = "And(Member(0,3),is_iterates_fm(big_union_fm(1,0),2,0,1))"
note nat_in_M â¹AâMâº
moreover from this
have "big_union(##M,a,b) â·
(M, [b,a,c,d,e,f,g,h,i,j,k,n,y,A,nat] ⨠big_union_fm(1,0))"
if "aâM" "bâM" "câM" "dâM" "eâM" "fâM""gâM""hâM""iâM""jâM" "kâM" "nâM" "yâM"
for a b c d e f g h i j k n y
using that by simp
moreover from calculation
have "(M, [n,y,A,nat] ⨠is_iterates_fm(big_union_fm(1,0),2,0,1)) â·
is_iterates(##M, big_union(##M), A, n , y)"
if "nâM" "yâM" for n y
using that sats_is_iterates_fm[of M "big_union(##M)"]
by simp
moreover from calculation
have "(M, [n,y,A,nat] ⨠?f) â·
nânat â§ is_iterates(##M, big_union(##M), A, n, y)"
if "nâM" "yâM" for n y
using that
by simp
moreover
have "arity(?f) = 4"
using arity_is_iterates_fm[where p="big_union_fm(1,0)" and i=2]
arity_big_union_fm arity_And ord_simp_union
by simp
ultimately
show ?thesis
using repl_sats[of M ?f "[A,nat]"] replacement_ax1(5)[unfolded replacement_assm_def]
by simp
qed
sublocale M_ZF1_trans â M_datatypes "##M"
using list_repl1_intf list_repl2_intf formula_repl1_intf
formula_repl2_intf tl_repl_intf
by unfold_locales auto
sublocale M_ZF1_trans â M_eclose "##M"
using eclose_repl1_intf eclose_repl2_intf
by unfold_locales auto
textâ¹Interface with \<^locale>â¹M_ecloseâº.âº
lemma (in M_ZF1_trans) Powapply_repl :
assumes "fâM"
shows "strong_replacement(##M,λx y. y=Powapply_rel(##M,f,x))"
proof -
note assms
moreover
have "arity(is_Powapply_fm(2,0,1)) = 3"
unfolding is_Powapply_fm_def
by (simp add:arity ord_simp_union)
moreover from calculation
have iff:"z=Powapply_rel(##M,f,p) ⷠ(M, [p,z,f] ⨠is_Powapply_fm(2,0,1) )"
if "pâM" "zâM" for p z
using that zero_in_M sats_is_Powapply_fm[of 2 0 1 "[p,z,f]" M] is_Powapply_iff
replacement_ax1[unfolded replacement_assm_def]
by simp
ultimately
show ?thesis
using replacement_ax1(6)[unfolded replacement_assm_def]
by (rule_tac strong_replacement_cong[THEN iffD2,OF iff],simp_all)
qed
lemma (in M_ZF1_trans) phrank_repl :
assumes
"fâM"
shows
"strong_replacement(##M, λx y. y = succ(f`x))"
proof -
note assms
moreover from this
have iff:"y = succ(f ` x) â· M, [x, y, f] ⨠PHrank_fm(2, 0, 1)" if "xâM" "yâM" for x y
using PHrank_iff_sats[of 2 "[x,y,f]" f 0 _ 1 _ M] zero_in_M that
apply_closed
unfolding PHrank_def
by simp
moreover
have "arity(PHrank_fm(2,0,1)) = 3"
unfolding PHrank_fm_def
by (simp add:arity ord_simp_union)
ultimately
show ?thesis
using replacement_ax1(7)[unfolded replacement_assm_def]
unfolding PHrank_def
by(rule_tac strong_replacement_cong[THEN iffD2,OF iff],simp_all)
qed
declare is_Hrank_fm_def[fm_definitions add]
declare PHrank_fm_def[fm_definitions add]
lemma (in M_ZF1_trans) wfrec_rank :
assumes "XâM"
shows "wfrec_replacement(##M,is_Hrank(##M),rrank(X))"
proof -
let ?f="Exists(And(pair_fm(1,0,2),is_wfrec_fm(is_Hrank_fm(2,1,0),3,1,0)))"
note assms zero_in_M
moreover from this
have
"is_Hrank(##M,a2, a1, a0) â·
(M, [a0,a1,a2,a3,a4,y,x,z,rrank(X)] ⨠is_Hrank_fm(2,1,0))"
if "a4âM" "a3âM" "a2âM" "a1âM" "a0âM" "yâM" "xâM" "zâM" for a4 a3 a2 a1 a0 y x z
using that rrank_in_M is_Hrank_iff_sats
by simp
moreover from calculation
have "(M, [y,x,z,rrank(X)] ⨠is_wfrec_fm(is_Hrank_fm(2,1,0),3,1,0)) â·
is_wfrec(##M, is_Hrank(##M) ,rrank(X), x, y)"
if "yâM" "xâM" "zâM" for y x z
using that rrank_in_M sats_is_wfrec_fm
by simp
moreover from calculation
have "(M, [x,z,rrank(X)] ⨠?f) â·
(âyâM. pair(##M,x,y,z) â§ is_wfrec(##M, is_Hrank(##M) , rrank(X), x, y))"
if "xâM" "zâM" for x z
using that rrank_in_M
by (simp del:pair_abs)
moreover
have "arity(?f) = 3"
using arity_wfrec_replacement_fm[where p="is_Hrank_fm(2,1,0)" and i=3,simplified]
arity_is_Hrank_fm[of 2 1 0,simplified] ord_simp_union
by simp
moreover from calculation
have "strong_replacement(##M,λx z. (M, [x,z,rrank(X)] ⨠?f))"
using replacement_ax1(8)[unfolded replacement_assm_def] rrank_in_M
by simp
ultimately
show ?thesis
using repl_sats[of M ?f "[rrank(X)]"]
unfolding wfrec_replacement_def
by (simp del:pair_abs)
qed
schematic_goal sats_is_Vset_fm_auto:
assumes
"iânat" "vânat" "envâlist(A)" "0âA"
"i < length(env)" "v < length(env)"
shows
"is_Vset(##A,nth(i, env),nth(v, env)) ⷠ(A, env ⨠?ivs_fm(i,v))"
unfolding is_Vset_def is_Vfrom_def
by (insert assms; (rule sep_rules is_HVfrom_iff_sats is_transrec_iff_sats | simp)+)
synthesize "is_Vset" from_schematic "sats_is_Vset_fm_auto"
arity_theorem for "is_Vset_fm"
lemma (in M_ZF1_trans) trans_repl_HVFrom :
assumes "AâM" "iâM"
shows "transrec_replacement(##M,is_HVfrom(##M,A),i)"
proof -
let ?f="Exists(And(pair_fm(1,0,2),is_wfrec_fm(is_HVfrom_fm(8,2,1,0),4,1,0)))"
note facts = assms zero_in_M
moreover
have "âsaâM. âesaâM. âmesaâM.
upair(##M,a,a,sa) â§ is_eclose(##M,sa,esa) â§ membership(##M,esa,mesa)"
if "aâM" for a
using that upair_ax eclose_closed Memrel_closed
unfolding upair_ax_def
by (simp del:upair_abs)
moreover
{
fix mesa
assume "mesaâM"
moreover
note facts
moreover from calculation
have "is_HVfrom(##M,A,a2, a1, a0) â·
(M, [a0,a1,a2,a3,a4,y,x,z,A,mesa] ⨠is_HVfrom_fm(8,2,1,0))"
if "a4âM" "a3âM" "a2âM" "a1âM" "a0âM" "yâM" "xâM" "zâM" for a4 a3 a2 a1 a0 y x z
using that sats_is_HVfrom_fm
by simp
moreover from calculation
have "(M, [y,x,z,A,mesa] ⨠is_wfrec_fm(is_HVfrom_fm(8,2,1,0),4,1,0)) â·
is_wfrec(##M, is_HVfrom(##M,A),mesa, x, y)"
if "yâM" "xâM" "zâM" for y x z
using that sats_is_wfrec_fm
by simp
moreover from calculation
have "(M, [x,z,A,mesa] ⨠?f) â·
(âyâM. pair(##M,x,y,z) â§ is_wfrec(##M, is_HVfrom(##M,A) , mesa, x, y))"
if "xâM" "zâM" for x z
using that
by (simp del:pair_abs)
moreover
have "arity(?f) = 4"
using arity_wfrec_replacement_fm[where p="is_HVfrom_fm(8,2,1,0)" and i=9]
arity_is_HVfrom_fm ord_simp_union
by simp
moreover from calculation
have "strong_replacement(##M,λx z. (M, [x,z,A,mesa] ⨠?f))"
using replacement_ax1(9)[unfolded replacement_assm_def]
by simp
ultimately
have "wfrec_replacement(##M,is_HVfrom(##M,A),mesa)"
using repl_sats[of M ?f "[A,mesa]"]
unfolding wfrec_replacement_def
by (simp del:pair_abs)
}
ultimately
show ?thesis
unfolding transrec_replacement_def
by simp
qed
sublocale M_ZF1_trans â M_Vfrom "##M"
using power_ax Powapply_repl phrank_repl trans_repl_HVFrom wfrec_rank
by unfold_locales auto
subsectionâ¹Interface for proving Collects and Replace in M.âº
context M_ZF1_trans
begin
lemma Collect_in_M :
assumes
"Ï â formula" "envâlist(M)"
"arity(Ï) ⤠1 +â©Ï length(env)" "AâM" and
satsQ: "âx. xâM â¹ (M, [x]@env ⨠Ï) â· Q(x)"
shows
"{yâA . Q(y)}âM"
proof -
have "separation(##M,λx. (M, [x] @ env ⨠Ï))"
using assms separation_ax by simp
then
show ?thesis
using â¹AâM⺠satsQ transitivity separation_closed
separation_cong[of "##M" "λy. (M, [y]@env ⨠Ï)" "Q"]
by simp
qed
lemma separation_in_M :
assumes
"Ï â formula" "envâlist(M)"
"arity(Ï) ⤠1 +â©Ï length(env)" "AâM" and
satsQ: "âx. xâA â¹ (M, [x]@env ⨠Ï) â· Q(x)"
shows
"{yâA . Q(y)} â M"
proof -
let ?Ï' = "And(Ï,Member(0,length(env)+â©Ï1))"
note assms
moreover
have "arity(?Ï') ⤠1 +â©Ï length(env@[A])"
using assms Un_le le_trans[of "arity(Ï)" "1+â©Ïlength(env)" "2+â©Ïlength(env)"]
by (force simp:FOL_arities)
moreover from calculation
have "?Ï'âformula" "nth(length(env), env @ [A]) = A"
using nth_append
by auto
moreover from calculation
have "â x . x â M â¹ (M, [x]@env@[A] ⨠?Ï') â· Q(x) â§ xâA"
using arity_sats_iff[of _ "[A]" _ "[_]@env"]
by auto
ultimately
show ?thesis
using Collect_in_M[of ?Ï' "env@[A]" _ "λx . Q(x) â§ xâA", OF _ _ _ â¹AâMâº]
by auto
qed
end
context M_Z_trans
begin
lemma strong_replacement_in_ctm:
assumes
f_fm: "Ï â formula" and
f_ar: "arity(Ï)⤠2 +â©Ï length(env)" and
fsats: "âx y. xâM â¹ yâM â¹ (M,[x,y]@env ⨠Ï) â· y = f(x)" and
fclosed: "âx. xâM â¹ f(x) â M" and
phi_replacement:"replacement_assm(M,env,Ï)" and
"envâlist(M)"
shows "strong_replacement(##M, λx y . y = f(x))"
using assms
strong_replacement_cong[of "##M" "λx y. M,[x,y]@envâ¨Ï" "λx y. y = f(x)"]
unfolding replacement_assm_def
by auto
lemma strong_replacement_rel_in_ctm :
assumes
f_fm: "Ï â formula" and
f_ar: "arity(Ï)⤠2 +â©Ï length(env)" and
fsats: "âx y. xâM â¹ yâM â¹ (M,[x,y]@env ⨠Ï) â· f(x,y)" and
phi_replacement:"replacement_assm(M,env,Ï)" and
"envâlist(M)"
shows "strong_replacement(##M, f)"
using assms
strong_replacement_cong[of "##M" "λx y. M,[x,y]@envâ¨Ï" "f"]
unfolding replacement_assm_def
by auto
lemma Replace_in_M :
assumes
f_fm: "Ï â formula" and
f_ar: "arity(Ï)⤠2 +â©Ï length(env)" and
fsats: "âx y. xâA â¹ yâM â¹ (M,[x,y]@env ⨠Ï) â· y = f(x)" and
fclosed: "âx. xâA â¹ f(x) â M" and
"AâM" "envâlist(M)" and
phi'_replacement:"replacement_assm(M,env@[A], â
Ï â§ â
0 â length(env) +â©Ï 2â
â
)"
shows "{f(x) . xâA}âM"
proof -
let ?Ï' = "And(Ï,Member(0,length(env)+â©Ï2))"
note assms
moreover from this
have "arity(?Ï') ⤠2 +â©Ï length(env@[A])"
using Un_le le_trans[of "arity(Ï)" "2+â©Ï(length(env))" "3+â©Ïlength(env)"]
by (force simp:FOL_arities)
moreover from calculation
have "?Ï'âformula" "nth(length(env), env @ [A]) = A"
using nth_append by auto
moreover from calculation
have "â x y. x â M â¹ yâM â¹ (M,[x,y]@env@[A]â¨?Ï') â· y=f(x) â§xâA"
using arity_sats_iff[of _ "[A]" _ "[_,_]@env"]
by auto
moreover from calculation
have "strong_replacement(##M, λx y. M,[x,y]@env@[A] ⨠?Ï')"
using phi'_replacement assms(1-6) unfolding replacement_assm_def by simp
ultimately
have 4:"strong_replacement(##M, λx y. y = f(x) â§ xâA)"
using
strong_replacement_cong[of "##M" "λx y. M,[x,y]@env@[A]â¨?Ï'" "λx y. y = f(x) â§ xâA"]
by simp
then
have "{y . xâA , y = f(x)} â M"
using â¹AâM⺠strong_replacement_closed[OF 4,of A] fclosed by simp
moreover
have "{f(x). xâA} = { y . xâA , y = f(x)}"
by auto
ultimately
show ?thesis by simp
qed
lemma Replace_relativized_in_M :
assumes
f_fm: "Ï â formula" and
f_ar: "arity(Ï)⤠2 +â©Ï length(env)" and
fsats: "âx y. xâA â¹ yâM â¹ (M,[x,y]@env ⨠Ï) â· is_f(x,y)" and
fabs: "âx y. xâA â¹ yâM â¹ is_f(x,y) â· y = f(x)" and
fclosed: "âx. xâA â¹ f(x) â M" and
"AâM" "envâlist(M)" and
phi'_replacement:"replacement_assm(M,env@[A], â
Ï â§ â
0 â length(env) +â©Ï 2â
â
)"
shows "{f(x) . xâA}âM"
using assms Replace_in_M[of Ï] by auto
lemma ren_action :
assumes
"envâlist(M)" "xâM" "yâM" "zâM"
shows "â i . i < 2+â©Ïlength(env) â¶
nth(i,[x,z]@env) = nth(Ï_repl(length(env))`i,[z,x,y]@env)"
proof -
let ?f="{â¨0, 1â©, â¨1, 0â©}"
have 1:"(âj. j < length(env) â¹ nth(j, env) = nth(id(length(env)) ` j, env))"
using assms ltD by simp
have 2:"nth(j, [x,z]) = nth(?f ` j, [z,x,y])" if "j<2" for j
proof -
consider "j=0" | "j=1" using ltD[OF â¹j<2âº] by auto
then show ?thesis
proof(cases)
case 1
then show ?thesis using apply_equality f_type by simp
next
case 2
then show ?thesis using apply_equality f_type by simp
qed
qed
show ?thesis
using sum_action[OF _ _ _ _ f_type id_type _ _ _ _ _ _ _ 2 1,simplified] assms
unfolding Ï_repl_def by simp
qed
lemma Lambda_in_M :
assumes
f_fm: "Ï â formula" and
f_ar: "arity(Ï)⤠2 +â©Ï length(env)" and
fsats: "âx y. xâA â¹ yâM â¹ (M,[x,y]@env ⨠Ï) â· is_f(x,y)" and
fabs: "âx y. xâA â¹ yâM â¹ is_f(x,y) â· y = f(x)" and
fclosed: "âx. xâA â¹ f(x) â M" and
"AâM" "envâlist(M)" and
phi'_replacement2: "replacement_assm(M,env@[A],Lambda_in_M_fm(Ï,length(env)))"
shows "(λxâA . f(x)) âM"
unfolding lam_def
proof -
let ?ren="Ï_repl(length(env))"
let ?j="2+â©Ïlength(env)"
let ?k="3+â©Ïlength(env)"
let ?Ï="ren(Ï)`?j`?k`?ren"
let ?Ï'="Exists(And(pair_fm(1,0,2),?Ï))"
let ?p="λx y. âzâM. pair(##M,x,z,y) â§ is_f(x,z)"
have "?Ï'âformula" "?Ïâformula"
using â¹envâ_⺠length_type f_fm ren_type ren_tc[of Ï "2+â©Ïlength(env)" "3+â©Ïlength(env)" ?ren]
by simp_all
moreover from this
have "arity(?Ï)â¤3+â©Ï(length(env))" "arity(?Ï)ânat"
using assms arity_ren[OF f_fm _ _ ren_type,of "length(env)"] by simp_all
then
have "arity(?Ï') ⤠2+â©Ï(length(env))"
using Un_le pred_Un_distrib assms pred_le
by (simp add:arity)
moreover from this calculation
have "xâA â¹ yâM â¹ (M,[x,y]@env ⨠?Ï') â· ?p(x,y)" for x y
using â¹envâ_⺠length_type[OF â¹envâ_âº] assms transitivity[OF _ â¹AâMâº]
sats_iff_sats_ren[OF f_fm _ _ _ _ ren_type f_ar ren_action[rule_format,of _ x y],of _ M ]
by auto
moreover
have "xâA â¹ yâM â¹ ?p(x,y) â· y = <x,f(x)>" for x y
using assms transitivity[OF _ â¹Aâ_âº] fclosed
by simp
moreover
have "â x . xâA â¹ <x,f(x)> â M"
using transitivity[OF _ â¹AâMâº] pair_in_M_iff fclosed by simp
ultimately
show "{â¨x,f(x)â© . xâA } â M"
using Replace_in_M[of ?Ï' env A] phi'_replacement2 â¹AâM⺠â¹envâ_âº
by simp
qed
lemma ren_action' :
assumes
"envâlist(M)" "xâM" "yâM" "zâM" "uâM"
shows "â i . i < 3+â©Ïlength(env) â¶
nth(i,[x,z,u]@env) = nth(Ï_pair_repl(length(env))`i,[x,z,y,u]@env)"
proof -
let ?f="{â¨0, 0â©, â¨1, 1â©, â¨2,3â©}"
have 1:"(âj. j < length(env) â¹ nth(j, env) = nth(id(length(env)) ` j, env))"
using assms ltD by simp
have 2:"nth(j, [x,z,u]) = nth(?f ` j, [x,z,y,u])" if "j<3" for j
proof -
consider "j=0" | "j=1" | "j=2" using ltD[OF â¹j<3âº] by auto
then show ?thesis
proof(cases)
case 1
then show ?thesis using apply_equality f_type' by simp
next
case 2
then show ?thesis using apply_equality f_type' by simp
next
case 3
then show ?thesis using apply_equality f_type' by simp
qed
qed
show ?thesis
using sum_action[OF _ _ _ _ f_type' id_type _ _ _ _ _ _ _ 2 1,simplified] assms
unfolding Ï_pair_repl_def by simp
qed
lemma LambdaPair_in_M :
assumes
f_fm: "Ï â formula" and
f_ar: "arity(Ï)⤠3 +â©Ï length(env)" and
fsats: "âx z r. xâM â¹ zâM â¹ râM â¹ (M,[x,z,r]@env ⨠Ï) â· is_f(x,z,r)" and
fabs: "âx z r. xâM â¹ zâM â¹ râM â¹ is_f(x,z,r) â· r = f(x,z)" and
fclosed: "âx z. xâM â¹ zâM â¹ f(x,z) â M" and
"AâM" "envâlist(M)" and
phi'_replacement3: "replacement_assm(M,env@[A],LambdaPair_in_M_fm(Ï,length(env)))"
shows "(λxâA . f(fst(x),snd(x))) âM"
proof -
let ?ren="Ï_pair_repl(length(env))"
let ?j="3+â©Ïlength(env)"
let ?k="4+â©Ïlength(env)"
let ?Ï="ren(Ï)`?j`?k`?ren"
let ?Ï'="Exists(Exists(And(fst_fm(2,0),(And(snd_fm(2,1),?Ï)))))"
let ?p="λx y. is_f(fst(x),snd(x),y)"
have "?Ï'âformula" "?Ïâformula"
using â¹envâ_⺠length_type f_fm ren_type' ren_tc[of Ï ?j ?k ?ren]
by simp_all
moreover from this
have "arity(?Ï)â¤4+â©Ï(length(env))" "arity(?Ï)ânat"
using assms arity_ren[OF f_fm _ _ ren_type',of "length(env)"] by simp_all
moreover from calculation
have 1:"arity(?Ï') ⤠2+â©Ï(length(env))" "?Ï'âformula"
using Un_le pred_Un_distrib assms pred_le
by (simp_all add:arity)
moreover from this calculation
have 2:"xâA â¹ yâM â¹ (M,[x,y]@env ⨠?Ï') â· ?p(x,y)" for x y
using
sats_iff_sats_ren[OF f_fm _ _ _ _ ren_type' f_ar
ren_action'[rule_format,of _ "fst(x)" x "snd(x)" y],simplified]
â¹envâ_⺠length_type[OF â¹envâ_âº] transitivity[OF _ â¹AâMâº]
fst_snd_closed pair_in_M_iff fsats[of "fst(x)" "snd(x)" y,symmetric]
fst_abs snd_abs
by auto
moreover from assms
have 3:"xâA â¹ yâM â¹ ?p(x,y) â· y = f(fst(x),snd(x))" for x y
using fclosed fst_snd_closed pair_in_M_iff fabs transitivity
by auto
moreover
have 4:"â x . xâA â¹ <x,f(fst(x),snd(x))> â M" "â x . xâA â¹ f(fst(x),snd(x)) â M"
using transitivity[OF _ â¹AâMâº] pair_in_M_iff fclosed fst_snd_closed
by simp_all
ultimately
show ?thesis
using Lambda_in_M[unfolded Lambda_in_M_fm_def, of ?Ï', OF _ _ _ _ _ _ _
phi'_replacement3[unfolded LambdaPair_in_M_fm_def]]
â¹envâ_⺠â¹Aâ_⺠by simp
qed
lemma (in M_ZF1_trans) lam_replacement2_in_ctm :
assumes
f_fm: "Ï â formula" and
f_ar: "arity(Ï)⤠3 +â©Ï length(env)" and
fsats: "âx z r. xâM â¹ zâM â¹ râM â¹ (M,[x,z,r]@env ⨠Ï) â· is_f(x,z,r)" and
fabs: "âx z r. xâM â¹ zâM â¹ râM â¹ is_f(x,z,r) â· r = f(x,z)" and
fclosed: "âx z. xâM â¹ zâM â¹ f(x,z) â M" and
"envâlist(M)" and
phi'_replacement3: "âA. AâM â¹ replacement_assm(M,env@[A],LambdaPair_in_M_fm(Ï,length(env)))"
shows "lam_replacement(##M , λx . f(fst(x),snd(x)))"
using
LambdaPair_in_M fabs
f_ar ord_simp_union transitivity assms fst_snd_closed
by (rule_tac lam_replacement_iff_lam_closed[THEN iffD2],simp_all)
simple_rename "ren_U" src "[z1,x_P, x_leq, x_o, x_t, z2_c]"
tgt "[z2_c,z1,z,x_P, x_leq, x_o, x_t]"
simple_rename "ren_V" src "[fz,x_P, x_leq, x_o,x_f, x_t, gz]"
tgt "[gz,fz,z,x_P, x_leq, x_o,x_f, x_t]"
simple_rename "ren_V3" src "[fz,x_P, x_leq, x_o,x_f, gz, hz]"
tgt "[hz,gz,fz,z,x_P, x_leq, x_o,x_f]"
lemma separation_sat_after_function_1:
assumes "[a,b,c,d]âlist(M)" and "Ïâformula" and "arity(Ï) ⤠6"
and
f_fm: "f_fm â formula" and
f_ar: "arity(f_fm) ⤠6" and
fsats: "â fx x. fxâM â¹ xâM â¹ (M,[fx,x]@[a, b, c, d] ⨠f_fm) â· fx=f(x)" and
fclosed: "âx . xâM â¹ f(x) â M" and
g_fm: "g_fm â formula" and
g_ar: "arity(g_fm) ⤠7" and
gsats: "â gx fx x. gxâM â¹ fxâM â¹ xâM â¹ (M,[gx,fx,x]@[a, b, c, d] ⨠g_fm) â· gx=g(x)" and
gclosed: "âx . xâM â¹ g(x) â M"
shows "separation(##M, λr. M, [f(r), a, b, c, d, g(r)] ⨠Ï)"
proof -
note types = assms(1-4)
let ?Ï="ren(Ï)`6`7`ren_U_fn"
let ?Ï'="Exists(And(f_fm,Exists(And(g_fm,?Ï))))"
let ?Ï="λz.[f(z), a, b, c, d, g(z)]"
let ?env="[a, b, c, d]"
let ?η="λz.[g(z),f(z),z]@?env"
note types
moreover from this
have "arity(Ï) ⤠7" "?Ïâformula"
using ord_simp_union ren_tc ren_U_thm(2)[folded ren_U_fn_def] le_trans[of "arity(Ï)" 6]
by simp_all
moreover from calculation
have "arity(?Ï) ⤠7" "?Ï'âformula"
using arity_ren ren_U_thm(2)[folded ren_U_fn_def] f_fm g_fm
by simp_all
moreover from calculation f_ar g_ar f_fm g_fm
have "arity(?Ï') ⤠5"
using ord_simp_union pred_le arity_type
by (simp add:arity)
moreover from calculation fclosed gclosed
have 0:"(M, [f(z), a, b, c, d, g(z)] ⨠Ï) â· (M,?η(z)⨠?Ï)" if "(##M)(z)" for z
using sats_iff_sats_ren[of Ï 6 7 _ _ "?η(z)"]
ren_U_thm(1)[where A=M,folded ren_U_fn_def] ren_U_thm(2)[folded ren_U_fn_def] that
by simp
moreover from calculation
have 1:"(M,?η(z)⨠?Ï) â· M,[z]@?envâ¨?Ï'" if "(##M)(z)" for z
using that fsats[OF fclosed[of z],of z] gsats[of "g(z)" "f(z)" z] fclosed gclosed f_fm g_fm
proof(rule_tac iffI,simp,rule_tac rev_bexI[where x="f(z)"],simp,(auto)[1])
assume "M, [z] @ [a, b, c, d] ⨠(â
ââ
f_fm â§ (â
ââ
g_fm â§ ren(Ï) ` 6 ` 7 ` ren_U_fnâ
â
)â
â
)"
then
have "âxaâM. (M, [xa, z, a, b, c, d] ⨠f_fm) â§
(âxâM. (M, [x, xa, z, a, b, c, d] ⨠g_fm) â§
(M, [x, xa, z, a, b, c, d] ⨠ren(Ï) ` 6 ` 7 ` ren_U_fn))"
using that calculation by auto
then
obtain xa x where "xâM" "xaâM" "M, [xa, z, a, b, c, d] ⨠f_fm"
"(M, [x, xa, z, a, b, c, d] ⨠g_fm)"
"(M, [x, xa, z, a, b, c, d] ⨠ren(Ï) ` 6 ` 7 ` ren_U_fn)"
using that calculation by auto
moreover from this
have "xa=f(z)" "x=g(z)" using fsats[of xa] gsats[of x xa] that by simp_all
ultimately
show "M, [g(z), f(z), z] @ [a, b, c, d] ⨠ren(Ï) ` 6 ` 7 ` ren_U_fn"
by auto
qed
moreover from calculation
have "separation(##M, λz. (M,[z]@?env ⨠?Ï'))"
using separation_ax
by simp_all
ultimately
show ?thesis
by(rule_tac separation_cong[THEN iffD2,OF iff_trans[OF 0 1]],clarify,force)
qed
lemma separation_sat_after_function3:
assumes "[a, b, c, d]âlist(M)" and "Ïâformula" and "arity(Ï) ⤠7"
and
f_fm: "f_fm â formula" and
f_ar: "arity(f_fm) ⤠6" and
fsats: "â fx x. fxâM â¹ xâM â¹ (M,[fx,x]@[a, b, c, d] ⨠f_fm) â· fx=f(x)" and
fclosed: "âx . xâM â¹ f(x) â M" and
g_fm: "g_fm â formula" and
g_ar: "arity(g_fm) ⤠7" and
gsats: "â gx fx x. gxâM â¹ fxâM â¹ xâM â¹ (M,[gx,fx,x]@[a, b, c, d] ⨠g_fm) â· gx=g(x)" and
gclosed: "âx . xâM â¹ g(x) â M" and
h_fm: "h_fm â formula" and
h_ar: "arity(h_fm) ⤠8" and
hsats: "â hx gx fx x. hxâM â¹ gxâM â¹ fxâM â¹ xâM â¹ (M,[hx,gx,fx,x]@[a, b, c, d] ⨠h_fm) â· hx=h(x)" and
hclosed: "âx . xâM â¹ h(x) â M"
shows "separation(##M, λr. M, [f(r), a, b, c, d, g(r), h(r)] ⨠Ï)"
proof -
note types = assms(1-3)
let ?Ï="Ï"
let ?Ï="ren(?Ï)`7`8`ren_V3_fn"
let ?Ï'="Exists(And(f_fm,Exists(And(g_fm,Exists(And(h_fm,?Ï))))))"
let ?Ï="λz.[f(z), a, b, c, d,g(z), h(z)]"
let ?env="[a, b, c, d]"
let ?η="λz.[h(z),g(z),f(z),z]@?env"
note types
moreover from this
have "?Ïâformula" by simp
moreover from calculation
have "arity(?Ï) ⤠9" "?Ïâformula"
using ord_simp_union ren_tc ren_V3_thm(2)[folded ren_V3_fn_def] le_trans[of "arity(Ï)" 7]
by simp_all
moreover from calculation
have "arity(?Ï) ⤠8" "?Ï'âformula"
using arity_ren ren_V3_thm(2)[folded ren_V3_fn_def] f_fm g_fm h_fm
by (simp_all)
moreover from this f_ar g_ar f_fm g_fm h_fm h_ar â¹?Ï'â_âº
have "arity(?Ï') ⤠5"
using ord_simp_union arity_type nat_into_Ord
by (simp add:arity,(rule_tac pred_le,simp,rule_tac Un_le,simp)+,simp_all add: â¹?Ïâ_âº)
moreover from calculation fclosed gclosed hclosed
have 0:"(M, ?Ï(z) ⨠?Ï) â· (M,?η(z)⨠?Ï)" if "(##M)(z)" for z
using sats_iff_sats_ren[of ?Ï 7 8 "?Ï(z)" M "?η(z)"]
ren_V3_thm(1)[where A=M,folded ren_V3_fn_def,simplified] ren_V3_thm(2)[folded ren_V3_fn_def] that
by simp
moreover from calculation
have 1:"(M,?η(z)⨠?Ï) â· M,[z]@?envâ¨?Ï'" if "(##M)(z)" for z
using that fsats[OF fclosed[of z],of z] gsats[of "g(z)" "f(z)" z]
hsats[of "h(z)" "g(z)" "f(z)" z]
fclosed gclosed hclosed f_fm g_fm h_fm
apply(rule_tac iffI,simp,rule_tac rev_bexI[where x="f(z)"],simp)
apply(rule_tac conjI,simp,rule_tac rev_bexI[where x="g(z)"],simp)
apply(rule_tac conjI,simp,rule_tac rev_bexI[where x="h(z)"],simp,rule_tac conjI,simp,simp)
proof -
assume "M, [z] @ [a, b, c, d] ⨠(â
ââ
f_fm â§ (â
ââ
g_fm â§ (â
ââ
h_fm â§ ren(Ï) ` 7 ` 8 ` ren_V3_fnâ
â
)â
â
)â
â
)"
with calculation that
have "âxâM. (M, [x, z, a, b, c, d] ⨠f_fm) â§
(âxaâM. (M, [xa, x, z, a, b, c, d] ⨠g_fm) â§ (âxbâM. (M, [xb, xa, x, z, a, b, c, d] ⨠h_fm) â§ (M, [xb, xa, x, z, a, b, c, d] ⨠ren(Ï) ` 7 ` 8 ` ren_V3_fn)))"
by auto
with calculation
obtain x where "xâM" "(M, [x, z, a, b, c, d] ⨠f_fm)"
"(âxaâM. (M, [xa, x, z, a, b, c, d] ⨠g_fm) â§ (âxbâM. (M, [xb, xa, x, z, a, b, c, d] ⨠h_fm) â§ (M, [xb, xa, x, z, a, b, c, d] ⨠ren(Ï) ` 7 ` 8 ` ren_V3_fn)))"
by force
moreover from this
have "x=f(z)" using fsats[of x] that by simp
moreover from calculation
obtain xa where "xaâM" "(M, [xa, x, z, a, b, c, d] ⨠g_fm)"
"(âxbâM. (M, [xb, xa, x, z, a, b, c, d] ⨠h_fm) â§ (M, [xb, xa, x, z, a, b, c, d] ⨠ren(Ï) ` 7 ` 8 ` ren_V3_fn))"
by auto
moreover from calculation
have "xa=g(z)" using gsats[of xa x] that by simp
moreover from calculation
obtain xb where "xbâM" "(M, [xb, xa, x, z, a, b, c, d] ⨠h_fm)"
"(M, [xb, xa, x, z, a, b, c, d] ⨠ren(Ï) ` 7 ` 8 ` ren_V3_fn)"
by auto
moreover from calculation
have "xb=h(z)" using hsats[of xb xa x] that by simp
ultimately
show "M, [h(z), g(z), f(z), z] @ [a, b, c, d] ⨠ren(Ï) ` 7 ` 8 ` ren_V3_fn"
by auto
qed
moreover from calculation â¹?Ï'â_âº
have "separation(##M, λz. (M,[z]@?env ⨠?Ï'))"
using separation_ax
by simp
ultimately
show ?thesis
by(rule_tac separation_cong[THEN iffD2,OF iff_trans[OF 0 1]],clarify,force)
qed
lemma separation_sat_after_function:
assumes "[a, b, c, d, Ï]âlist(M)" and "Ïâformula" and "arity(Ï) ⤠7"
and
f_fm: "f_fm â formula" and
f_ar: "arity(f_fm) ⤠7" and
fsats: "â fx x. fxâM â¹ xâM â¹ (M,[fx,x]@[a, b, c, d, Ï] ⨠f_fm) â· fx=f(x)" and
fclosed: "âx . xâM â¹ f(x) â M" and
g_fm: "g_fm â formula" and
g_ar: "arity(g_fm) ⤠8" and
gsats: "â gx fx x. gxâM â¹ fxâM â¹ xâM â¹ (M,[gx,fx,x]@[a, b, c, d, Ï] ⨠g_fm) â· gx=g(x)" and
gclosed: "âx . xâM â¹ g(x) â M"
shows "separation(##M, λr. M, [f(r), a, b, c, d, Ï, g(r)] ⨠Ï)"
proof -
note types = assms(1-3)
let ?Ï="Ï"
let ?Ï="ren(?Ï)`7`8`ren_V_fn"
let ?Ï'="Exists(And(f_fm,Exists(And(g_fm,?Ï))))"
let ?Ï="λz.[f(z), a, b, c, d, Ï, g(z)]"
let ?env="[a, b, c, d, Ï]"
let ?η="λz.[g(z),f(z),z]@?env"
note types
moreover from this
have "?Ïâformula" by simp
moreover from calculation
have "arity(?Ï) ⤠8" "?Ïâformula"
using ord_simp_union ren_tc ren_V_thm(2)[folded ren_V_fn_def] le_trans[of "arity(Ï)" 7]
by simp_all
moreover from calculation
have "arity(?Ï) ⤠8" "?Ï'âformula"
using arity_ren ren_V_thm(2)[folded ren_V_fn_def] f_fm g_fm
by (simp_all)
moreover from calculation f_ar g_ar f_fm g_fm
have "arity(?Ï') ⤠6"
using ord_simp_union pred_le arity_type
by (simp add:arity)
moreover from calculation fclosed gclosed
have 0:"(M, ?Ï(z) ⨠?Ï) â· (M,?η(z)⨠?Ï)" if "(##M)(z)" for z
using sats_iff_sats_ren[of ?Ï 7 8 "?Ï(z)" _ "?η(z)"]
ren_V_thm(1)[where A=M,folded ren_V_fn_def] ren_V_thm(2)[folded ren_V_fn_def] that
by simp
moreover from calculation
have 1:"(M,?η(z)⨠?Ï) â· M,[z]@?envâ¨?Ï'" if "(##M)(z)" for z
using that fsats[OF fclosed[of z],of z] gsats[of "g(z)" "f(z)" z]
fclosed gclosed f_fm g_fm
apply(rule_tac iffI,simp,rule_tac rev_bexI[where x="f(z)"],simp)
apply(auto)[1]
proof -
assume "M, [z] @ [a, b, c, d, Ï] ⨠(â
ââ
f_fm â§ (â
ââ
g_fm â§ ren(Ï) ` 7 ` 8 ` ren_V_fnâ
â
)â
â
)"
then have "âxaâM. (M, [xa, z, a, b, c, d, Ï] ⨠f_fm) â§
(âxâM. (M, [x, xa, z, a, b, c, d, Ï] ⨠g_fm) â§ (M, [x, xa, z, a, b, c, d, Ï] ⨠ren(Ï) ` 7 ` 8 ` ren_V_fn))"
using that calculation by auto
then
obtain xa where "xaâM" "M, [xa, z, a, b, c, d, Ï] ⨠f_fm"
"(âxâM. (M, [x, xa, z, a, b, c, d, Ï] ⨠g_fm) â§ (M, [x, xa, z, a, b, c, d, Ï] ⨠ren(Ï) ` 7 ` 8 ` ren_V_fn))"
by auto
moreover from this
have "xa=f(z)" using fsats[of xa] that by simp
moreover from calculation
obtain x where "xâM" "M, [x, xa, z, a, b, c, d, Ï] ⨠g_fm" "M, [x, xa, z, a, b, c, d, Ï] ⨠ren(Ï) ` 7 ` 8 ` ren_V_fn"
by auto
moreover from calculation
have "x=g(z)" using gsats[of x xa] that by simp
ultimately
show "M, [g(z), f(z), z] @ [a, b, c, d, Ï] ⨠ren(Ï) ` 7 ` 8 ` ren_V_fn"
by auto
qed
moreover from calculation
have "separation(##M, λz. (M,[z]@?env ⨠?Ï'))"
using separation_ax
by simp_all
ultimately
show ?thesis
by(rule_tac separation_cong[THEN iffD2,OF iff_trans[OF 0 1]],clarify,force)
qed
end
end dy>
Theory Forcing_Data
sectionâ¹Transitive set models of ZFâº
textâ¹This theory defines locales for countable transitive models of $\ZF$,
and on top of that, one that includes a forcing notion. Weakened versions
of both locales are included, that only assume finitely many replacement
instances.âº
theory Forcing_Data
imports
Forcing_Notions
Cohen_Posets_Relative
Interface
begin
locale M_ctm1 = M_ZF1_trans +
fixes enum
assumes M_countable: "enumâbij(nat,M)"
locale M_ctm1_AC = M_ctm1 + M_ZFC1_trans
subsectionâ¹A forcing locale and generic filtersâº
txtâ¹Ideally, countability should be separated from the assumption of this locale.
The fact is that our present proofs of the "definition of forces" (and many
consequences) and of the lemma for âforcing a valueâ of function
unnecessarily depend on the countability of the ground model. âº
locale forcing_data1 = forcing_notion + M_ctm1 +
assumes P_in_M: "P â M"
and leq_in_M: "leq â M"
context forcing_data1
begin
lemma P_sub_M : "PâM"
using transitivity P_in_M by auto
definition
M_generic :: "iâo" where
"M_generic(G) â¡ filter(G) â§ (âDâM. DâP â§ dense(D)â¶Dâ©Gâ 0)"
lemma M_genericD [dest]: "M_generic(G) â¹ xâG â¹ xâP"
unfolding M_generic_def by (blast dest:filterD)
lemma M_generic_leqD [dest]: "M_generic(G) â¹ pâG â¹ qâP â¹ pâ¼q â¹ qâG"
unfolding M_generic_def by (blast dest:filter_leqD)
lemma M_generic_compatD [dest]: "M_generic(G) â¹ pâG â¹ râG â¹ âqâG. qâ¼p â§ qâ¼r"
unfolding M_generic_def by (blast dest:low_bound_filter)
lemma M_generic_denseD [dest]: "M_generic(G) â¹ dense(D) â¹ DâP â¹ DâM â¹ âqâG. qâD"
unfolding M_generic_def by blast
lemma G_nonempty: "M_generic(G) â¹ Gâ 0"
using P_in_M P_dense subset_refl[of P]
unfolding M_generic_def
by auto
lemma one_in_G :
assumes "M_generic(G)"
shows "ð â G"
proof -
from assms
have "GâP"
unfolding M_generic_def filter_def by simp
from â¹M_generic(G)âº
have "increasing(G)"
unfolding M_generic_def filter_def by simp
with â¹GâP⺠â¹M_generic(G)âº
show ?thesis
using G_nonempty one_in_P one_max
unfolding increasing_def by blast
qed
lemma G_subset_M: "M_generic(G) â¹ G â M"
using transitivity[OF _ P_in_M] by auto
declare iff_trans [trans]
lemma generic_filter_existence:
"pâP â¹ âG. pâG â§ M_generic(G)"
proof -
assume "pâP"
let ?D="λnânat. (if (enum`nâP â§ dense(enum`n)) then enum`n else P)"
have "ânânat. ?D`n â Pow(P)"
by auto
then
have "?D:natâPow(P)"
using lam_type by auto
have "ânânat. dense(?D`n)"
proof(intro ballI)
fix n
assume "nânat"
then
have "dense(?D`n) â· dense(if enum`n â P â§ dense(enum`n) then enum`n else P)"
by simp
also
have "... â· (¬(enum`n â P â§ dense(enum`n)) â¶ dense(P)) "
using split_if by simp
finally
show "dense(?D`n)"
using P_dense â¹nânat⺠by auto
qed
with â¹?Dâ_âº
interpret cg: countable_generic P leq ð ?D
by (unfold_locales, auto)
from â¹pâPâº
obtain G where 1: "pâG â§ filter(G) â§ (ânânat.(?D`n)â©Gâ 0)"
using cg.countable_rasiowa_sikorski[where M="λ_. M"] P_sub_M
M_countable[THEN bij_is_fun] M_countable[THEN bij_is_surj, THEN surj_range]
unfolding cg.D_generic_def by blast
then
have "(âDâM. DâP â§ dense(D)â¶Dâ©Gâ 0)"
proof (intro ballI impI)
fix D
assume "DâM" and 2: "D â P â§ dense(D) "
moreover
have "âyâM. âxânat. enum`x= y"
using M_countable and bij_is_surj unfolding surj_def by (simp)
moreover from calculation
obtain n where Eq10: "nânat â§ enum`n = D"
by auto
moreover from calculation if_P
have "?D`n = D"
by simp
moreover
note 1
ultimately
show "Dâ©Gâ 0"
by auto
qed
with 1
show ?thesis
unfolding M_generic_def by auto
qed
lemma one_in_M: "ð â M"
using one_in_P P_in_M transitivity
by simp
end
end
Theory Forces_Definition
sectionâ¹The definition of \<^term>â¹forcesâºâº
theory Forces_Definition
imports
Forcing_Data
begin
textâ¹This is the core of our development.âº
subsectionâ¹The relation \<^term>â¹frecrelâºâº
lemma names_belowsD:
assumes "x â names_below(P,z)"
obtains f n1 n2 p where
"x = â¨f,n1,n2,pâ©" "fâ2" "n1âecloseN(z)" "n2âecloseN(z)" "pâP"
using assms unfolding names_below_def by auto
context forcing_data1
begin
lemma ftype_abs:
"â¦xâM; yâM â§ â¹ is_ftype(##M,x,y) â· y = ftype(x)"
unfolding ftype_def is_ftype_def by (simp add:absolut)
lemma name1_abs:
"â¦xâM; yâM â§ â¹ is_name1(##M,x,y) â· y = name1(x)"
unfolding name1_def is_name1_def
by (rule is_hcomp_abs[OF fst_abs],simp_all add: fst_snd_closed[simplified] absolut)
lemma snd_snd_abs:
"â¦xâM; yâM â§ â¹ is_snd_snd(##M,x,y) â· y = snd(snd(x))"
unfolding is_snd_snd_def
by (rule is_hcomp_abs[OF snd_abs],
simp_all add: conjunct2[OF fst_snd_closed,simplified] absolut)
lemma name2_abs:
"â¦xâM; yâM â§ â¹ is_name2(##M,x,y) â· y = name2(x)"
unfolding name2_def is_name2_def
by (rule is_hcomp_abs[OF fst_abs snd_snd_abs],simp_all add:absolut conjunct2[OF fst_snd_closed,simplified])
lemma cond_of_abs:
"â¦xâM; yâM â§ â¹ is_cond_of(##M,x,y) â· y = cond_of(x)"
unfolding cond_of_def is_cond_of_def
by (rule is_hcomp_abs[OF snd_abs snd_snd_abs];simp_all add:fst_snd_closed[simplified])
lemma tuple_abs:
"â¦zâM;t1âM;t2âM;pâM;tâMâ§ â¹
is_tuple(##M,z,t1,t2,p,t) â· t = â¨z,t1,t2,pâ©"
unfolding is_tuple_def using pair_in_M_iff by simp
lemmas components_abs = ftype_abs name1_abs name2_abs cond_of_abs
tuple_abs
lemma comp_in_M:
"p â¼ q â¹ pâM"
"p â¼ q â¹ qâM"
using leq_in_M transitivity[of _ leq] pair_in_M_iff by auto
lemma eq_case_abs [simp]:
assumes "t1âM" "t2âM" "pâM" "fâM"
shows "is_eq_case(##M,t1,t2,p,P,leq,f) â· eq_case(t1,t2,p,P,leq,f)"
proof -
have "q â¼ p â¹ qâM" for q
using comp_in_M by simp
moreover
have "â¨s,yâ©ât â¹ sâdomain(t)" if "tâM" for s y t
using that unfolding domain_def by auto
ultimately
have
"(âsâM. s â domain(t1) ⨠s â domain(t2) â¶ (âqâM. qâP â§ q â¼ p â¶
(f ` â¨1, s, t1, qâ© =1 â· f ` â¨1, s, t2, qâ©=1))) â·
(âs. s â domain(t1) ⨠s â domain(t2) â¶ (âq. qâP â§ q â¼ p â¶
(f ` â¨1, s, t1, qâ© =1 â· f ` â¨1, s, t2, qâ©=1)))"
using assms domain_trans[OF trans_M,of t1] domain_trans[OF trans_M,of t2]
by auto
then
show ?thesis
unfolding eq_case_def is_eq_case_def
using assms pair_in_M_iff nat_into_M domain_closed apply_closed leq_in_M zero_in_M Un_closed
by (simp add:components_abs)
qed
lemma mem_case_abs [simp]:
assumes "t1âM" "t2âM" "pâM" "fâM"
shows "is_mem_case(##M,t1,t2,p,P,leq,f) â· mem_case(t1,t2,p,P,leq,f)"
proof
{
fix v
assume "vâP" "v â¼ p" "is_mem_case(##M,t1,t2,p,P,leq,f)"
moreover
from this
have "vâM" "â¨v,pâ© â M" "(##M)(v)"
using transitivity[OF _ P_in_M,of v] transitivity[OF _ leq_in_M]
by simp_all
moreover
from calculation assms
obtain q r s where
"r â P â§ q â P â§ â¨q, vâ© â M â§ â¨s, râ© â M â§ â¨q, râ© â M â§ 0 â M â§
â¨0, t1, s, qâ© â M â§ q â¼ v â§ â¨s, râ© â t2 â§ q â¼ r â§ f ` â¨0, t1, s, qâ© = 1"
unfolding is_mem_case_def by (auto simp add:components_abs)
then
have "âq s r. r â P â§ q â P â§ q â¼ v â§ â¨s, râ© â t2 â§ q â¼ r â§ f ` â¨0, t1, s, qâ© = 1"
by auto
}
then
show "mem_case(t1, t2, p, P, leq, f)" if "is_mem_case(##M, t1, t2, p, P, leq, f)"
unfolding mem_case_def using that assms by auto
next
{ fix v
assume "v â M" "v â P" "â¨v, pâ© â M" "v â¼ p" "mem_case(t1, t2, p, P, leq, f)"
moreover
from this
obtain q s r where "r â P â§ q â P â§ q â¼ v â§ â¨s, râ© â t2 â§ q â¼ r â§ f ` â¨0, t1, s, qâ© = 1"
unfolding mem_case_def by auto
moreover
from this â¹t2âMâº
have "râM" "qâM" "sâM" "r â P â§ q â P â§ q â¼ v â§ â¨s, râ© â t2 â§ q â¼ r â§ f ` â¨0, t1, s, qâ© = 1"
using transitivity domainI[of s r] P_in_M domain_closed
by auto
moreover
note â¹t1âMâº
ultimately
have "âqâM . âsâM. ârâM.
r â P â§ q â P â§ â¨q, vâ© â M â§ â¨s, râ© â M â§ â¨q, râ© â M â§ 0 â M â§
â¨0, t1, s, qâ© â M â§ q â¼ v â§ â¨s, râ© â t2 â§ q â¼ r â§ f ` â¨0, t1, s, qâ© = 1"
using pair_in_M_iff zero_in_M by auto
}
then
show "is_mem_case(##M, t1, t2, p, P, leq, f)" if "mem_case(t1, t2, p, P, leq, f)"
unfolding is_mem_case_def
using assms that zero_in_M pair_in_M_iff apply_closed nat_into_M
by (auto simp add:components_abs)
qed
lemma Hfrc_abs:
"â¦fnncâM; fâMâ§ â¹
is_Hfrc(##M,P,leq,fnnc,f) â· Hfrc(P,leq,fnnc,f)"
unfolding is_Hfrc_def Hfrc_def using pair_in_M_iff zero_in_M
by (auto simp add:components_abs)
lemma Hfrc_at_abs:
"â¦fnncâM; fâM ; zâMâ§ â¹
is_Hfrc_at(##M,P,leq,fnnc,f,z) â· z = bool_of_o(Hfrc(P,leq,fnnc,f)) "
unfolding is_Hfrc_at_def using Hfrc_abs
by auto
lemma components_closed :
"xâM â¹ (##M)(ftype(x))"
"xâM â¹ (##M)(name1(x))"
"xâM â¹ (##M)(name2(x))"
"xâM â¹ (##M)(cond_of(x))"
unfolding ftype_def name1_def name2_def cond_of_def using fst_snd_closed by simp_all
lemma ecloseN_closed:
"(##M)(A) â¹ (##M)(ecloseN(A))"
"(##M)(A) â¹ (##M)(eclose_n(name1,A))"
"(##M)(A) â¹ (##M)(eclose_n(name2,A))"
unfolding ecloseN_def eclose_n_def
using components_closed eclose_closed singleton_closed Un_closed by auto
lemma eclose_n_abs :
assumes "xâM" "ecâM"
shows "is_eclose_n(##M,is_name1,ec,x) â· ec = eclose_n(name1,x)"
"is_eclose_n(##M,is_name2,ec,x) â· ec = eclose_n(name2,x)"
unfolding is_eclose_n_def eclose_n_def
using assms name1_abs name2_abs eclose_abs singleton_closed components_closed
by auto
lemma ecloseN_abs :
"â¦xâM;ecâMâ§ â¹ is_ecloseN(##M,x,ec) â· ec = ecloseN(x)"
unfolding is_ecloseN_def ecloseN_def
using eclose_n_abs Un_closed union_abs ecloseN_closed
by auto
lemma frecR_abs :
"xâM â¹ yâM â¹ frecR(x,y) â· is_frecR(##M,x,y)"
unfolding frecR_def is_frecR_def
using zero_in_M domain_closed Un_closed components_closed nat_into_M
by (auto simp add: components_abs)
lemma frecrelP_abs :
"zâM â¹ frecrelP(##M,z) â· (âx y. z = â¨x,yâ© â§ frecR(x,y))"
using pair_in_M_iff frecR_abs unfolding frecrelP_def by auto
lemma frecrel_abs:
assumes "AâM" "râM"
shows "is_frecrel(##M,A,r) â· r = frecrel(A)"
proof -
from â¹AâMâº
have "zâM" if "zâAÃA" for z
using cartprod_closed transitivity that by simp
then
have "Collect(AÃA,frecrelP(##M)) = Collect(AÃA,λz. (âx y. z = â¨x,yâ© â§ frecR(x,y)))"
using Collect_cong[of "AÃA" "AÃA" "frecrelP(##M)"] assms frecrelP_abs by simp
with assms
show ?thesis
unfolding is_frecrel_def def_frecrel using cartprod_closed
by simp
qed
lemma frecrel_closed:
assumes "xâM"
shows "frecrel(x)âM"
proof -
have "Collect(xÃx,λz. (âx y. z = â¨x,yâ© â§ frecR(x,y)))âM"
using Collect_in_M[of "frecrelP_fm(0)" "[]"] arity_frecrelP_fm sats_frecrelP_fm
frecrelP_abs â¹xâM⺠cartprod_closed
by simp
then
show ?thesis
unfolding frecrel_def Rrel_def frecrelP_def by simp
qed
lemma field_frecrel : "field(frecrel(names_below(P,x))) â names_below(P,x)"
unfolding frecrel_def
using field_Rrel by simp
lemma forcerelD : "uv â forcerel(P,x) â¹ uvâ names_below(P,x) Ã names_below(P,x)"
unfolding forcerel_def
using trancl_type field_frecrel by blast
lemma wf_forcerel :
"wf(forcerel(P,x))"
unfolding forcerel_def using wf_trancl wf_frecrel .
lemma restrict_trancl_forcerel:
assumes "frecR(w,y)"
shows "restrict(f,frecrel(names_below(P,x))-``{y})`w
= restrict(f,forcerel(P,x)-``{y})`w"
unfolding forcerel_def frecrel_def using assms restrict_trancl_Rrel[of frecR]
by simp
lemma names_belowI :
assumes "frecR(â¨ft,n1,n2,pâ©,â¨a,b,c,dâ©)" "pâP"
shows "â¨ft,n1,n2,pâ© â names_below(P,â¨a,b,c,dâ©)" (is "?x â names_below(_,?y)")
proof -
from assms
have "ft â 2" "a â 2"
unfolding frecR_def by (auto simp add:components_simp)
from assms
consider (e) "n1 â domain(b) ⪠domain(c) â§ (n2 = b ⨠n2 =c)"
| (m) "n1 = b â§ n2 â domain(c)"
unfolding frecR_def by (auto simp add:components_simp)
then show ?thesis
proof cases
case e
then
have "n1 â eclose(b) ⨠n1 â eclose(c)"
using Un_iff in_dom_in_eclose by auto
with e
have "n1 â ecloseN(?y)" "n2 â ecloseN(?y)"
using ecloseNI components_in_eclose by auto
with â¹ftâ2⺠â¹pâPâº
show ?thesis
unfolding names_below_def by auto
next
case m
then
have "n1 â ecloseN(?y)" "n2 â ecloseN(?y)"
using mem_eclose_trans ecloseNI
in_dom_in_eclose components_in_eclose by auto
with â¹ftâ2⺠â¹pâPâº
show ?thesis
unfolding names_below_def
by auto
qed
qed
lemma names_below_tr :
assumes "xâ names_below(P,y)" "yâ names_below(P,z)"
shows "xâ names_below(P,z)"
proof -
let ?A="λy . names_below(P,y)"
note assms
moreover from this
obtain fx x1 x2 px where "x = â¨fx,x1,x2,pxâ©" "fxâ2" "x1âecloseN(y)" "x2âecloseN(y)" "pxâP"
unfolding names_below_def by auto
moreover from calculation
obtain fy y1 y2 py where "y = â¨fy,y1,y2,pyâ©" "fyâ2" "y1âecloseN(z)" "y2âecloseN(z)" "pyâP"
unfolding names_below_def by auto
moreover from calculation
have "x1âecloseN(z)" "x2âecloseN(z)"
using ecloseN_mono names_simp by auto
ultimately
have "xâ?A(z)"
unfolding names_below_def by simp
then
show ?thesis using subsetI by simp
qed
lemma arg_into_names_below2 :
assumes "â¨x,yâ© â frecrel(names_below(P,z))"
shows "x â names_below(P,y)"
proof -
from assms
have "xânames_below(P,z)" "yânames_below(P,z)" "frecR(x,y)"
unfolding frecrel_def Rrel_def
by auto
obtain f n1 n2 p where "x = â¨f,n1,n2,pâ©" "fâ2" "n1âecloseN(z)" "n2âecloseN(z)" "pâP"
using â¹xânames_below(P,z)âº
unfolding names_below_def by auto
moreover
obtain fy m1 m2 q where "qâP" "y = â¨fy,m1,m2,qâ©"
using â¹yânames_below(P,z)âº
unfolding names_below_def by auto
moreover
note â¹frecR(x,y)âº
ultimately
show ?thesis
using names_belowI by simp
qed
lemma arg_into_names_below :
assumes "â¨x,yâ© â frecrel(names_below(P,z))"
shows "x â names_below(P,x)"
proof -
from assms
have "xânames_below(P,z)"
unfolding frecrel_def Rrel_def
by auto
from â¹xânames_below(P,z)âº
obtain f n1 n2 p where
"x = â¨f,n1,n2,pâ©" "fâ2" "n1âecloseN(z)" "n2âecloseN(z)" "pâP"
unfolding names_below_def by auto
then
have "n1âecloseN(x)" "n2âecloseN(x)"
using components_in_eclose by simp_all
with â¹fâ2⺠â¹pâP⺠â¹x = â¨f,n1,n2,pâ©âº
show ?thesis
unfolding names_below_def by simp
qed
lemma forcerel_arg_into_names_below :
assumes "â¨x,yâ© â forcerel(P,z)"
shows "x â names_below(P,x)"
using assms
unfolding forcerel_def
by(rule trancl_induct;auto simp add: arg_into_names_below)
lemma names_below_mono :
assumes "â¨x,yâ© â frecrel(names_below(P,z))"
shows "names_below(P,x) â names_below(P,y)"
proof -
from assms
have "xânames_below(P,y)"
using arg_into_names_below2 by simp
then
show ?thesis
using names_below_tr subsetI by simp
qed
lemma frecrel_mono :
assumes "â¨x,yâ© â frecrel(names_below(P,z))"
shows "frecrel(names_below(P,x)) â frecrel(names_below(P,y))"
unfolding frecrel_def
using Rrel_mono names_below_mono assms by simp
lemma forcerel_mono2 :
assumes "â¨x,yâ© â frecrel(names_below(P,z))"
shows "forcerel(P,x) â forcerel(P,y)"
unfolding forcerel_def
using trancl_mono frecrel_mono assms by simp
lemma forcerel_mono_aux :
assumes "â¨x,yâ© â frecrel(names_below(P, w))^+"
shows "forcerel(P,x) â forcerel(P,y)"
using assms
by (rule trancl_induct,simp_all add: subset_trans forcerel_mono2)
lemma forcerel_mono :
assumes "â¨x,yâ© â forcerel(P,z)"
shows "forcerel(P,x) â forcerel(P,y)"
using forcerel_mono_aux assms unfolding forcerel_def by simp
lemma forcerel_eq_aux: "x â names_below(P, w) â¹ â¨x,yâ© â forcerel(P,z) â¹
(y â names_below(P, w) â¶ â¨x,yâ© â forcerel(P,w))"
unfolding forcerel_def
proof(rule_tac a=x and b=y and P="λ y . y â names_below(P, w) â¶ â¨x,yâ© â frecrel(names_below(P,w))^+" in trancl_induct,simp)
let ?A="λ a . names_below(P, a)"
let ?R="λ a . frecrel(?A(a))"
let ?fR="λ a .forcerel(a)"
show "uâ?A(w) â¶ â¨x,uâ©â?R(w)^+" if "xâ?A(w)" "â¨x,yâ©â?R(z)^+" "â¨x,uâ©â?R(z)" for u
using that frecrelD frecrelI r_into_trancl
unfolding names_below_def by simp
{
fix u v
assume "x â ?A(w)"
"â¨x, yâ© â ?R(z)^+"
"â¨x, uâ© â ?R(z)^+"
"â¨u, vâ© â ?R(z)"
"u â ?A(w) â¹ â¨x, uâ© â ?R(w)^+"
then
have "v â ?A(w) â¹ â¨x, vâ© â ?R(w)^+"
proof -
assume "v â?A(w)"
from â¹â¨u,vâ©â_âº
have "uâ?A(v)"
using arg_into_names_below2 by simp
with â¹v â?A(w)âº
have "uâ?A(w)"
using names_below_tr by simp
with â¹vâ_⺠â¹â¨u,vâ©â_âº
have "â¨u,vâ©â ?R(w)"
using frecrelD frecrelI r_into_trancl unfolding names_below_def by simp
with â¹u â ?A(w) â¹ â¨x, uâ© â ?R(w)^+⺠â¹uâ?A(w)âº
have "â¨x, uâ© â ?R(w)^+"
by simp
with â¹â¨u,vâ©â ?R(w)âº
show "â¨x,vâ©â ?R(w)^+" using trancl_trans r_into_trancl
by simp
qed
}
then
show "v â ?A(w) â¶ â¨x, vâ© â ?R(w)^+"
if "x â ?A(w)"
"â¨x, yâ© â ?R(z)^+"
"â¨x, uâ© â ?R(z)^+"
"â¨u, vâ© â ?R(z)"
"u â ?A(w) â¶ â¨x, uâ© â ?R(w)^+" for u v
using that
by simp
qed
lemma forcerel_eq :
assumes "â¨z,xâ© â forcerel(P,x)"
shows "forcerel(P,z) = forcerel(P,x) â© names_below(P,z)Ãnames_below(P,z)"
using assms forcerel_eq_aux forcerelD forcerel_mono[of z x x] subsetI
by auto
lemma forcerel_below_aux :
assumes "â¨z,xâ© â forcerel(P,x)" "â¨u,zâ© â forcerel(P,x)"
shows "u â names_below(P,z)"
using assms(2)
unfolding forcerel_def
proof(rule trancl_induct)
show "u â names_below(P,y)" if " â¨u, yâ© â frecrel(names_below(P, x))" for y
using that vimage_singleton_iff arg_into_names_below2 by simp
next
show "u â names_below(P,z)"
if "â¨u, yâ© â frecrel(names_below(P, x))^+"
"â¨y, zâ© â frecrel(names_below(P, x))"
"u â names_below(P, y)"
for y z
using that arg_into_names_below2[of y z x] names_below_tr by simp
qed
lemma forcerel_below :
assumes "â¨z,xâ© â forcerel(P,x)"
shows "forcerel(P,x) -`` {z} â names_below(P,z)"
using vimage_singleton_iff assms forcerel_below_aux by auto
lemma relation_forcerel :
shows "relation(forcerel(P,z))" "trans(forcerel(P,z))"
unfolding forcerel_def using relation_trancl trans_trancl by simp_all
lemma Hfrc_restrict_trancl: "bool_of_o(Hfrc(P, leq, y, restrict(f,frecrel(names_below(P,x))-``{y})))
= bool_of_o(Hfrc(P, leq, y, restrict(f,(frecrel(names_below(P,x))^+)-``{y})))"
unfolding Hfrc_def bool_of_o_def eq_case_def mem_case_def
using restrict_trancl_forcerel frecRI1 frecRI2 frecRI3
unfolding forcerel_def
by simp
lemma frc_at_trancl: "frc_at(P,leq,z) = wfrec(forcerel(P,z),z,λx f. bool_of_o(Hfrc(P,leq,x,f)))"
unfolding frc_at_def forcerel_def using wf_eq_trancl Hfrc_restrict_trancl by simp
lemma forcerelI1 :
assumes "n1 â domain(b) ⨠n1 â domain(c)" "pâP" "dâP"
shows "â¨â¨1, n1, b, pâ©, â¨0,b,c,dâ©â©â forcerel(P,â¨0,b,c,dâ©)"
proof -
let ?x="â¨1, n1, b, pâ©"
let ?y="â¨0,b,c,dâ©"
from assms
have "frecR(?x,?y)"
using frecRI1 by simp
then
have "?xânames_below(P,?y)" "?y â names_below(P,?y)"
using names_belowI assms components_in_eclose
unfolding names_below_def by auto
with â¹frecR(?x,?y)âº
show ?thesis
unfolding forcerel_def frecrel_def
using subsetD[OF r_subset_trancl[OF relation_Rrel]] RrelI
by auto
qed
lemma forcerelI2 :
assumes "n1 â domain(b) ⨠n1 â domain(c)" "pâP" "dâP"
shows "â¨â¨1, n1, c, pâ©, â¨0,b,c,dâ©â©â forcerel(P,â¨0,b,c,dâ©)"
proof -
let ?x="â¨1, n1, c, pâ©"
let ?y="â¨0,b,c,dâ©"
note assms
moreover from this
have "frecR(?x,?y)"
using frecRI2 by simp
moreover from calculation
have "?xânames_below(P,?y)" "?y â names_below(P,?y)"
using names_belowI components_in_eclose
unfolding names_below_def by auto
ultimately
show ?thesis
unfolding forcerel_def frecrel_def
using subsetD[OF r_subset_trancl[OF relation_Rrel]] RrelI
by auto
qed
lemma forcerelI3 :
assumes "â¨n2, râ© â c" "pâP" "dâP" "r â P"
shows "â¨â¨0, b, n2, pâ©,â¨1, b, c, dâ©â© â forcerel(P,â¨1,b,c,dâ©)"
proof -
let ?x="â¨0, b, n2, pâ©"
let ?y="â¨1, b, c, dâ©"
note assms
moreover from this
have "frecR(?x,?y)"
using frecRI3 by simp
moreover from calculation
have "?xânames_below(P,?y)" "?y â names_below(P,?y)"
using names_belowI components_in_eclose
unfolding names_below_def by auto
ultimately
show ?thesis
unfolding forcerel_def frecrel_def
using subsetD[OF r_subset_trancl[OF relation_Rrel]] RrelI
by auto
qed
lemmas forcerelI = forcerelI1[THEN vimage_singleton_iff[THEN iffD2]]
forcerelI2[THEN vimage_singleton_iff[THEN iffD2]]
forcerelI3[THEN vimage_singleton_iff[THEN iffD2]]
lemma aux_def_frc_at:
assumes "z â forcerel(P,x) -`` {x}"
shows "wfrec(forcerel(P,x), z, H) = wfrec(forcerel(P,z), z, H)"
proof -
let ?A="names_below(P,z)"
from assms
have "â¨z,xâ© â forcerel(P,x)"
using vimage_singleton_iff by simp
moreover from this
have "z â ?A"
using forcerel_arg_into_names_below by simp
moreover from calculation
have "forcerel(P,z) = forcerel(P,x) â© (?AÃ?A)"
"forcerel(P,x) -`` {z} â ?A"
using forcerel_eq forcerel_below
by auto
moreover from calculation
have "wfrec(forcerel(P,x), z, H) = wfrec[?A](forcerel(P,x), z, H)"
using wfrec_trans_restr[OF relation_forcerel(1) wf_forcerel relation_forcerel(2), of x z ?A]
by simp
ultimately
show ?thesis
using wfrec_restr_eq by simp
qed
subsectionâ¹Recursive expression of \<^term>â¹frc_atâºâº
lemma def_frc_at :
assumes "pâP"
shows
"frc_at(P,leq,â¨ft,n1,n2,pâ©) =
bool_of_o( p âP â§
( ft = 0 â§ (âs. sâdomain(n1) ⪠domain(n2) â¶
(âq. qâP â§ q â¼ p â¶ (frc_at(P,leq,â¨1,s,n1,qâ©) =1 â· frc_at(P,leq,â¨1,s,n2,qâ©) =1)))
⨠ft = 1 â§ ( âvâP. v â¼ p â¶
(âq. âs. âr. râP â§ qâP â§ q â¼ v â§ â¨s,râ© â n2 â§ q â¼ r â§ frc_at(P,leq,â¨0,n1,s,qâ©) = 1))))"
proof -
let ?r="λy. forcerel(P,y)" and ?Hf="λx f. bool_of_o(Hfrc(P,leq,x,f))"
let ?t="λy. ?r(y) -`` {y}"
let ?arg="â¨ft,n1,n2,pâ©"
from wf_forcerel
have wfr: "âw . wf(?r(w))" ..
with wfrec [of "?r(?arg)" ?arg ?Hf]
have "frc_at(P,leq,?arg) = ?Hf( ?arg, λxâ?r(?arg) -`` {?arg}. wfrec(?r(?arg), x, ?Hf))"
using frc_at_trancl by simp
also
have " ... = ?Hf( ?arg, λxâ?r(?arg) -`` {?arg}. frc_at(P,leq,x))"
using aux_def_frc_at frc_at_trancl by simp
finally
show ?thesis
unfolding Hfrc_def mem_case_def eq_case_def
using forcerelI assms
by auto
qed
subsectionâ¹Absoluteness of \<^term>â¹frc_atâºâº
lemma forcerel_in_M :
assumes "xâM"
shows "forcerel(P,x)âM"
unfolding forcerel_def def_frecrel names_below_def
proof -
let ?Q = "2 Ã ecloseN(x) Ã ecloseN(x) Ã P"
have "?Q Ã ?Q â M"
using â¹xâM⺠P_in_M nat_into_M ecloseN_closed cartprod_closed by simp
moreover
have "separation(##M,λz. frecrelP(##M,z))"
using separation_in_ctm[of "frecrelP_fm(0)",OF _ _ _ sats_frecrelP_fm]
arity_frecrelP_fm frecrelP_fm_type
by auto
moreover from this
have "separation(##M,λz. âx y. z = â¨x, yâ© â§ frecR(x, y))"
using separation_cong[OF frecrelP_abs]
by force
ultimately
show "{z â ?Q à ?Q . âx y. z = â¨x, yâ© â§ frecR(x, y)}^+ â M"
using separation_closed frecrelP_abs trancl_closed
by simp
qed
lemma relation2_Hfrc_at_abs:
"relation2(##M,is_Hfrc_at(##M,P,leq),λx f. bool_of_o(Hfrc(P,leq,x,f)))"
unfolding relation2_def using Hfrc_at_abs
by simp
lemma Hfrc_at_closed :
"âxâM. âgâM. function(g) â¶ bool_of_o(Hfrc(P,leq,x,g))âM"
unfolding bool_of_o_def using zero_in_M nat_into_M[of 1] by simp
lemma wfrec_Hfrc_at :
assumes "XâM"
shows "wfrec_replacement(##M,is_Hfrc_at(##M,P,leq),forcerel(P,X))"
proof -
have 0:"is_Hfrc_at(##M,P,leq,a,b,c) â·
sats(M,Hfrc_at_fm(8,9,2,1,0),[c,b,a,d,e,y,x,z,P,leq,forcerel(P,X)])"
if "aâM" "bâM" "câM" "dâM" "eâM" "yâM" "xâM" "zâM"
for a b c d e y x z
using that P_in_M leq_in_M â¹XâM⺠forcerel_in_M
Hfrc_at_iff_sats[of concl:M P leq a b c 8 9 2 1 0
"[c,b,a,d,e,y,x,z,P,leq,forcerel(P,X)]"] by simp
have 1:"sats(M,is_wfrec_fm(Hfrc_at_fm(8,9,2,1,0),5,1,0),[y,x,z,P,leq,forcerel(P,X)]) â·
is_wfrec(##M, is_Hfrc_at(##M,P,leq),forcerel(P,X), x, y)"
if "xâM" "yâM" "zâM" for x y z
using that â¹XâM⺠forcerel_in_M P_in_M leq_in_M sats_is_wfrec_fm[OF 0]
by simp
let
?f="Exists(And(pair_fm(1,0,2),is_wfrec_fm(Hfrc_at_fm(8,9,2,1,0),5,1,0)))"
have satsf:"sats(M, ?f, [x,z,P,leq,forcerel(P,X)]) â·
(âyâM. pair(##M,x,y,z) & is_wfrec(##M, is_Hfrc_at(##M,P,leq),forcerel(P,X), x, y))"
if "xâM" "zâM" for x z
using that 1 â¹XâM⺠forcerel_in_M P_in_M leq_in_M by (simp del:pair_abs)
have artyf:"arity(?f) = 5"
using arity_wfrec_replacement_fm[where p="Hfrc_at_fm(8,9,2,1,0)" and i=10]
arity_Hfrc_at_fm ord_simp_union
by simp
moreover
have "?fâformula" by simp
ultimately
have "strong_replacement(##M,λx z. sats(M,?f,[x,z,P,leq,forcerel(P,X)]))"
using replacement_ax1(1) 1 artyf â¹XâM⺠forcerel_in_M P_in_M leq_in_M
unfolding replacement_assm_def by simp
then
have "strong_replacement(##M,λx z.
âyâM. pair(##M,x,y,z) & is_wfrec(##M, is_Hfrc_at(##M,P,leq),forcerel(P,X), x, y))"
using repl_sats[of M ?f "[P,leq,forcerel(P,X)]"] satsf by (simp del:pair_abs)
then
show ?thesis unfolding wfrec_replacement_def by simp
qed
lemma names_below_abs :
"â¦QâM;xâM;nbâMâ§ â¹ is_names_below(##M,Q,x,nb) â· nb = names_below(Q,x)"
unfolding is_names_below_def names_below_def
using succ_in_M_iff zero_in_M cartprod_closed ecloseN_abs ecloseN_closed
by auto
lemma names_below_closed:
"â¦QâM;xâMâ§ â¹ names_below(Q,x) â M"
unfolding names_below_def
using zero_in_M cartprod_closed ecloseN_closed succ_in_M_iff
by simp
lemma "names_below_productE" :
assumes "Q â M" "x â M"
"âA1 A2 A3 A4. A1 â M â¹ A2 â M â¹ A3 â M â¹ A4 â M â¹ R(A1 Ã A2 Ã A3 Ã A4)"
shows "R(names_below(Q,x))"
unfolding names_below_def using assms nat_into_M ecloseN_closed[of x] by auto
lemma forcerel_abs :
"â¦xâM;zâMâ§ â¹ is_forcerel(##M,P,x,z) â· z = forcerel(P,x)"
unfolding is_forcerel_def forcerel_def
using frecrel_abs names_below_abs trancl_abs P_in_M ecloseN_closed names_below_closed
names_below_productE[of concl:"λp. is_frecrel(##M,p,_) ⷠ_ = frecrel(p)"] frecrel_closed
by simp
lemma frc_at_abs:
assumes "fnncâM" "zâM"
shows "is_frc_at(##M,P,leq,fnnc,z) â· z = frc_at(P,leq,fnnc)"
proof -
from assms
have "(ârâM. is_forcerel(##M,P,fnnc, r) â§ is_wfrec(##M, is_Hfrc_at(##M, P, leq), r, fnnc, z))
â· is_wfrec(##M, is_Hfrc_at(##M, P, leq), forcerel(P,fnnc), fnnc, z)"
using forcerel_abs forcerel_in_M by simp
then
show ?thesis
unfolding frc_at_trancl is_frc_at_def
using assms wfrec_Hfrc_at[of fnnc] wf_forcerel relation_forcerel forcerel_in_M
Hfrc_at_closed relation2_Hfrc_at_abs
trans_wfrec_abs[of "forcerel(P,fnnc)" fnnc z "is_Hfrc_at(##M,P,leq)" "λx f. bool_of_o(Hfrc(P,leq,x,f))"]
by (simp flip:setclass_iff)
qed
lemma forces_eq'_abs :
"â¦pâM ; t1âM ; t2âMâ§ â¹ is_forces_eq'(##M,P,leq,p,t1,t2) â· forces_eq'(P,leq,p,t1,t2)"
unfolding is_forces_eq'_def forces_eq'_def
using frc_at_abs nat_into_M pair_in_M_iff by (auto simp add:components_abs)
lemma forces_mem'_abs :
"â¦pâM ; t1âM ; t2âMâ§ â¹ is_forces_mem'(##M,P,leq,p,t1,t2) â· forces_mem'(P,leq,p,t1,t2)"
unfolding is_forces_mem'_def forces_mem'_def
using frc_at_abs nat_into_M pair_in_M_iff by (auto simp add:components_abs)
lemma forces_neq'_abs :
assumes "pâM" "t1âM" "t2âM"
shows "is_forces_neq'(##M,P,leq,p,t1,t2) â· forces_neq'(P,leq,p,t1,t2)"
proof -
have "qâM" if "qâP" for q
using that transitivity P_in_M by simp
with assms
show ?thesis
unfolding is_forces_neq'_def forces_neq'_def
using forces_eq'_abs pair_in_M_iff
by (auto simp add:components_abs,blast)
qed
lemma forces_nmem'_abs :
assumes "pâM" "t1âM" "t2âM"
shows "is_forces_nmem'(##M,P,leq,p,t1,t2) â· forces_nmem'(P,leq,p,t1,t2)"
proof -
have "qâM" if "qâP" for q
using that transitivity P_in_M by simp
with assms
show ?thesis
unfolding is_forces_nmem'_def forces_nmem'_def
using forces_mem'_abs pair_in_M_iff
by (auto simp add:components_abs,blast)
qed
subsectionâ¹Forcing for general formulasâº
lemma leq_abs:
"⦠lâM ; qâM ; pâM â§ â¹ is_leq(##M,l,q,p) â· â¨q,pâ©âl"
unfolding is_leq_def using pair_in_M_iff by simp
subsectionâ¹Forcing for atomic formulas in contextâº
definition
forces_eq :: "[i,i,i] â o" (â¹_ forcesâ©a '(_ = _')⺠[36,1,1] 60) where
"forces_eq â¡ forces_eq'(P,leq)"
definition
forces_mem :: "[i,i,i] â o" (â¹_ forcesâ©a '(_ â _')⺠[36,1,1] 60) where
"forces_mem â¡ forces_mem'(P,leq)"
abbreviation is_forces_eq
where "is_forces_eq â¡ is_forces_eq'(##M,P,leq)"
abbreviation
is_forces_mem :: "[i,i,i] â o" where
"is_forces_mem â¡ is_forces_mem'(##M,P,leq)"
lemma def_forces_eq: "pâP â¹ p forcesâ©a (t1 = t2) â·
(âsâdomain(t1) ⪠domain(t2). âq. qâP â§ q â¼ p â¶
(q forcesâ©a (s â t1) â· q forcesâ©a (s â t2)))"
unfolding forces_eq_def forces_mem_def forces_eq'_def forces_mem'_def
using def_frc_at[of p 0 t1 t2 ]
unfolding bool_of_o_def
by auto
lemma def_forces_mem: "pâP â¹ p forcesâ©a (t1 â t2) â·
(âvâP. v â¼ p â¶
(âq. âs. âr. râP â§ qâP â§ q â¼ v â§ â¨s,râ© â t2 â§ q â¼ r â§ q forcesâ©a (t1 = s)))"
unfolding forces_eq'_def forces_mem'_def forces_eq_def forces_mem_def
using def_frc_at[of p 1 t1 t2]
unfolding bool_of_o_def
by auto
lemma forces_eq_abs :
"â¦pâM ; t1âM ; t2âMâ§ â¹ is_forces_eq(p,t1,t2) â· p forcesâ©a (t1 = t2)"
unfolding forces_eq_def
using forces_eq'_abs by simp
lemma forces_mem_abs :
"â¦pâM ; t1âM ; t2âMâ§ â¹ is_forces_mem(p,t1,t2) â· p forcesâ©a (t1 â t2)"
unfolding forces_mem_def
using forces_mem'_abs
by simp
definition
forces_neq :: "[i,i,i] â o" (â¹_ forcesâ©a '(_ â _')⺠[36,1,1] 60) where
"p forcesâ©a (t1 â t2) ⡠¬ (âqâP. qâ¼p â§ q forcesâ©a (t1 = t2))"
definition
forces_nmem :: "[i,i,i] â o" (â¹_ forcesâ©a '(_ â _')⺠[36,1,1] 60) where
"p forcesâ©a (t1 â t2) ⡠¬ (âqâP. qâ¼p â§ q forcesâ©a (t1 â t2))"
lemma forces_neq :
"p forcesâ©a (t1 â t2) â· forces_neq'(P,leq,p,t1,t2)"
unfolding forces_neq_def forces_neq'_def forces_eq_def by simp
lemma forces_nmem :
"p forcesâ©a (t1 â t2) â· forces_nmem'(P,leq,p,t1,t2)"
unfolding forces_nmem_def forces_nmem'_def forces_mem_def by simp
abbreviation Forces :: "[i, i, i] â o" ("_ â© _ _" [36,36,36] 60) where
"p â© Ï env â¡ M, ([p,P,leq,ð] @ env) ⨠forces(Ï)"
lemma sats_forces_Member :
assumes "xânat" "yânat" "envâlist(M)"
"nth(x,env)=xx" "nth(y,env)=yy" "qâM"
shows "q â© â
x â yâ
env â· q â P â§ is_forces_mem(q, xx, yy)"
unfolding forces_def
using assms P_in_M leq_in_M one_in_M
by simp
lemma sats_forces_Equal :
assumes "aânat" "bânat" "envâlist(M)" "nth(a,env)=x" "nth(b,env)=y" "qâM"
shows "q â© â
a = bâ
env â· q â P â§ is_forces_eq(q, x, y)"
unfolding forces_def
using assms P_in_M leq_in_M one_in_M
by simp
lemma sats_forces_Nand :
assumes "Ïâformula" "Ïâformula" "envâlist(M)" "pâM"
shows "p â© â
¬(Ï â§ Ï)â
env â·
pâP ⧠¬(âqâM. qâP â§ is_leq(##M,leq,q,p) â§
(M,[q,P,leq,ð]@env ⨠forces(Ï)) â§ (M,[q,P,leq,ð]@env ⨠forces(Ï)))"
unfolding forces_def
using sats_is_leq_fm_auto assms sats_ren_forces_nand P_in_M leq_in_M one_in_M zero_in_M
by simp
lemma sats_forces_Neg :
assumes "Ïâformula" "envâlist(M)" "pâM"
shows "p â© â
¬Ïâ
env â·
(pâP ⧠¬(âqâM. qâP â§ is_leq(##M,leq,q,p) â§ (M, [q, P, leq, ð] @ env ⨠forces(Ï))))"
unfolding Neg_def using assms sats_forces_Nand
by simp
lemma sats_forces_Forall :
assumes "Ïâformula" "envâlist(M)" "pâM"
shows "p â© (â
âÏâ
) env â· p â P â§ (âxâM. M,[p,P,leq,ð,x] @ env ⨠forces(Ï))"
unfolding forces_def using assms sats_ren_forces_forall P_in_M leq_in_M one_in_M
by simp
end
end v class="head">
Theory Names
sectionâ¹Names and generic extensionsâº
theory Names
imports
Forcing_Data
FrecR_Arities
begin
definition
Hv :: "[i,i,i,i]âi" where
"Hv(P,G,x,f) â¡ { z . yâ domain(x), (âpâP. â¨y,pâ© â x â§ p â G) â§ z=f`y}"
textâ¹The funcion \<^term>â¹val⺠interprets a name in \<^term>â¹Mâº
according to a (generic) filter \<^term>â¹Gâº. Note the definition
in terms of the well-founded recursor.âº
definition
val :: "[i,i,i]âi" where
"val(P,G,Ï) â¡ wfrec(edrel(eclose({Ï})), Ï ,Hv(P,G))"
definition
GenExt :: "[i,i,i]âi" ("_â_â[_]" [71,1])
where "MâPâ[G] â¡ {val(P,G,Ï). Ï â M}"
abbreviation (in forcing_notion)
GenExt_at_P :: "iâiâi" ("_[_]" [71,1])
where "M[G] â¡ MâPâ[G]"
subsectionâ¹Values and check-namesâº
context forcing_data1
begin
definition
Hcheck :: "[i,i] â i" where
"Hcheck(z,f) â¡ { â¨f`y,ðâ© . y â z}"
definition
check :: "i â i" where
"check(x) â¡ transrec(x , Hcheck)"
lemma checkD:
"check(x) = wfrec(Memrel(eclose({x})), x, Hcheck)"
unfolding check_def transrec_def ..
lemma Hcheck_trancl:"Hcheck(y, restrict(f,Memrel(eclose({x}))-``{y}))
= Hcheck(y, restrict(f,(Memrel(eclose({x}))^+)-``{y}))"
unfolding Hcheck_def
using restrict_trans_eq by simp
lemma check_trancl: "check(x) = wfrec(rcheck(x), x, Hcheck)"
using checkD wf_eq_trancl Hcheck_trancl unfolding rcheck_def by simp
lemma rcheck_in_M : "x â M â¹ rcheck(x) â M"
unfolding rcheck_def by (simp flip: setclass_iff)
lemma aux_def_check: "x â y â¹
wfrec(Memrel(eclose({y})), x, Hcheck) =
wfrec(Memrel(eclose({x})), x, Hcheck)"
by (rule wfrec_eclose_eq,auto simp add: arg_into_eclose eclose_sing)
lemma def_check : "check(y) = { â¨check(w),ðâ© . w â y}"
proof -
let
?r="λy. Memrel(eclose({y}))"
have wfr: "âw . wf(?r(w))"
using wf_Memrel ..
then
have "check(y)= Hcheck( y, λxâ?r(y) -`` {y}. wfrec(?r(y), x, Hcheck))"
using wfrec[of "?r(y)" y "Hcheck"] checkD by simp
also
have " ... = Hcheck( y, λxây. wfrec(?r(y), x, Hcheck))"
using under_Memrel_eclose arg_into_eclose by simp
also
have " ... = Hcheck( y, λxây. check(x))"
using aux_def_check checkD by simp
finally
show ?thesis
using Hcheck_def by simp
qed
lemma def_checkS :
fixes n
assumes "n â nat"
shows "check(succ(n)) = check(n) ⪠{â¨check(n),ðâ©}"
proof -
have "check(succ(n)) = {â¨check(i),ðâ© . i â succ(n)} "
using def_check by blast
also
have "... = {â¨check(i),ðâ© . i â n} ⪠{â¨check(n),ðâ©}"
by blast
also
have "... = check(n) ⪠{â¨check(n),ðâ©}"
using def_check[of n,symmetric] by simp
finally
show ?thesis .
qed
lemma field_Memrel2 :
assumes "x â M"
shows "field(Memrel(eclose({x}))) â M"
proof -
have "field(Memrel(eclose({x}))) â eclose({x})" "eclose({x}) â M"
using Ordinal.Memrel_type field_rel_subset assms eclose_least[OF trans_M] by auto
then
show ?thesis
using subset_trans by simp
qed
lemma aux_def_val:
assumes "z â domain(x)"
shows "wfrec(edrel(eclose({x})),z,Hv(P,G)) = wfrec(edrel(eclose({z})),z,Hv(P,G))"
proof -
let ?r="λx . edrel(eclose({x}))"
have "zâeclose({z})"
using arg_in_eclose_sing .
moreover
have "relation(?r(x))"
using relation_edrel .
moreover
have "wf(?r(x))"
using wf_edrel .
moreover from assms
have "tr_down(?r(x),z) â eclose({z})"
using tr_edrel_subset by simp
ultimately
have "wfrec(?r(x),z,Hv(P,G)) = wfrec[eclose({z})](?r(x),z,Hv(P,G))"
using wfrec_restr by simp
also from â¹zâdomain(x)âº
have "... = wfrec(?r(z),z,Hv(P,G))"
using restrict_edrel_eq wfrec_restr_eq by simp
finally
show ?thesis .
qed
textâ¹The next lemma provides the usual recursive expresion for the definition of termâ¹valâº.âº
lemma def_val: "val(P,G,x) = {z . tâdomain(x) , (âpâP . â¨t,pâ©âx â§ p â G) â§ z=val(P,G,t)}"
proof -
let
?r="Î»Ï . edrel(eclose({Ï}))"
let
?f="λzâ?r(x)-``{x}. wfrec(?r(x),z,Hv(P,G))"
have "âÏ. wf(?r(Ï))"
using wf_edrel by simp
with wfrec [of _ x]
have "val(P,G,x) = Hv(P,G,x,?f)"
using val_def by simp
also
have " ... = Hv(P,G,x,λzâdomain(x). wfrec(?r(x),z,Hv(P,G)))"
using dom_under_edrel_eclose by simp
also
have " ... = Hv(P,G,x,λzâdomain(x). val(P,G,z))"
using aux_def_val val_def by simp
finally
show ?thesis
using Hv_def by simp
qed
lemma val_mono : "xây â¹ val(P,G,x) â val(P,G,y)"
by (subst (1 2) def_val, force)
textâ¹Check-names are the canonical names for elements of the
ground model. Here we show that this is the case.âº
lemma valcheck : "ð â G â¹ ð â P â¹ val(P,G,check(y)) = y"
proof (induct rule:eps_induct)
case (1 y)
then show ?case
proof -
have "check(y) = { â¨check(w), ðâ© . w â y}" (is "_ = ?C")
using def_check .
then
have "val(P,G,check(y)) = val(P,G, {â¨check(w), ðâ© . w â y})"
by simp
also
have " ... = {z . tâdomain(?C) , (âpâP . â¨t, pâ©â?C â§ p â G) â§ z=val(P,G,t) }"
using def_val by blast
also
have " ... = {z . tâdomain(?C) , (âwây. t=check(w)) â§ z=val(P,G,t) }"
using 1 by simp
also
have " ... = {val(P,G,check(w)) . wây }"
by force
finally
show "val(P,G,check(y)) = y"
using 1 by simp
qed
qed
lemma val_of_name :
"val(P,G,{xâAÃP. Q(x)}) = {z . tâA , (âpâP . Q(â¨t,pâ©) â§ p â G) â§ z=val(P,G,t)}"
proof -
let
?n="{xâAÃP. Q(x)}" and
?r="Î»Ï . edrel(eclose({Ï}))"
let
?f="λzâ?r(?n)-``{?n}. val(P,G,z)"
have
wfR : "wf(?r(Ï))" for Ï
by (simp add: wf_edrel)
have "domain(?n) â A" by auto
{ fix t
assume H:"t â domain({x â A Ã P . Q(x)})"
then have "?f ` t = (if t â ?r(?n)-``{?n} then val(P,G,t) else 0)"
by simp
moreover have "... = val(P,G,t)"
using dom_under_edrel_eclose H if_P by auto
}
then
have Eq1: "t â domain({x â A Ã P . Q(x)}) â¹ val(P,G,t) = ?f` t" for t
by simp
have "val(P,G,?n) = {z . tâdomain(?n), (âp â P . â¨t,pâ© â ?n â§ p â G) â§ z=val(P,G,t)}"
by (subst def_val,simp)
also
have "... = {z . tâdomain(?n), (âpâP . â¨t,pâ©â?n â§ pâG) â§ z=?f`t}"
unfolding Hv_def
by (auto simp add:Eq1)
also
have "... = {z . tâdomain(?n), (âpâP . â¨t,pâ©â?n â§ pâG) â§ z=(if tâ?r(?n)-``{?n} then val(P,G,t) else 0)}"
by (simp)
also
have "... = { z . tâdomain(?n), (âpâP . â¨t,pâ©â?n â§ pâG) â§ z=val(P,G,t)}"
proof -
have "domain(?n) â ?r(?n)-``{?n}"
using dom_under_edrel_eclose by simp
then
have "âtâdomain(?n). (if tâ?r(?n)-``{?n} then val(P,G,t) else 0) = val(P,G,t)"
by auto
then
show "{ z . tâdomain(?n), (âpâP . â¨t,pâ©â?n â§ pâG) â§ z=(if tâ?r(?n)-``{?n} then val(P,G,t) else 0)} =
{ z . tâdomain(?n), (âpâP . â¨t,pâ©â?n â§ pâG) â§ z=val(P,G,t)}"
by auto
qed
also
have " ... = { z . tâA, (âpâP . â¨t,pâ©â?n â§ pâG) â§ z=val(P,G,t)}"
by force
finally
show " val(P,G,?n) = { z . tâA, (âpâP . Q(â¨t,pâ©) â§ pâG) â§ z=val(P,G,t)}"
by auto
qed
lemma val_of_name_alt :
"val(P,G,{xâAÃP. Q(x)}) = {z . tâA , (âpâPâ©G . Q(â¨t,pâ©)) â§ z=val(P,G,t) }"
using val_of_name by force
lemma val_only_names: "val(P,F,Ï) = val(P,F,{xâÏ. âtâdomain(Ï). âpâP. x=â¨t,pâ©})"
(is "_ = val(P,F,?name)")
proof -
have "val(P,F,?name) = {z . tâdomain(?name), (âpâP. â¨t, pâ© â ?name â§ p â F) â§ z=val(P,F, t)}"
using def_val by blast
also
have " ... = {val(P,F, t). tâ{yâdomain(Ï). âpâP. â¨y, pâ© â Ï â§ p â F}}"
by blast
also
have " ... = {z . tâdomain(Ï), (âpâP. â¨t, pâ© â Ï â§ p â F) â§ z=val(P,F, t)}"
by blast
also
have " ... = val(P,F, Ï)"
using def_val[symmetric] by blast
finally
show ?thesis ..
qed
lemma val_only_pairs: "val(P,F,Ï) = val(P,F,{xâÏ. ât p. x=â¨t,pâ©})"
proof
have "val(P,F,Ï) = val(P,F,{xâÏ. âtâdomain(Ï). âpâP. x=â¨t,pâ©})" (is "_ = val(P,F,?name)")
using val_only_names .
also
have "... â val(P,F,{xâÏ. ât p. x=â¨t,pâ©})"
using val_mono[of ?name "{xâÏ. ât p. x=â¨t,pâ©}"] by auto
finally
show "val(P,F,Ï) â val(P,F,{xâÏ. ât p. x=â¨t,pâ©})" by simp
next
show "val(P,F,{xâÏ. ât p. x=â¨t,pâ©}) â val(P,F,Ï)"
using val_mono[of "{xâÏ. ât p. x=â¨t,pâ©}"] by auto
qed
lemma val_subset_domain_times_range: "val(P,F,Ï) â val(P,F,domain(Ï)Ãrange(Ï))"
using val_only_pairs[THEN equalityD1]
val_mono[of "{x â Ï . ât p. x = â¨t, pâ©}" "domain(Ï)Ãrange(Ï)"] by blast
lemma val_subset_domain_times_P: "val(P,F,Ï) â val(P,F,domain(Ï)ÃP)"
using val_only_names[of F Ï] val_mono[of "{xâÏ. âtâdomain(Ï). âpâP. x=â¨t,pâ©}" "domain(Ï)ÃP" F]
by auto
lemma val_of_elem: "â¨Î¸,pâ© â Ï â¹ pâG â¹ pâP â¹ val(P,G,θ) â val(P,G,Ï)"
proof -
assume "â¨Î¸,pâ© â Ï"
then
have "θâdomain(Ï)"
by auto
assume "pâG" "pâP"
with â¹Î¸âdomain(Ï)⺠â¹â¨Î¸,pâ© â Ïâº
have "val(P,G,θ) â {z . tâdomain(Ï) , (âpâP . â¨t, pâ©âÏ â§ p â G) â§ z=val(P,G,t) }"
by auto
then
show ?thesis
by (subst def_val)
qed
lemma elem_of_val: "xâval(P,G,Ï) â¹ âθâdomain(Ï). val(P,G,θ) = x"
by (subst (asm) def_val,auto)
lemma elem_of_val_pair: "xâval(P,G,Ï) â¹ âθ. âpâG. â¨Î¸,pâ©âÏ â§ val(P,G,θ) = x"
by (subst (asm) def_val,auto)
lemma elem_of_val_pair':
assumes "ÏâM" "xâval(P,G,Ï)"
shows "âθâM. âpâG. â¨Î¸,pâ©âÏ â§ val(P,G,θ) = x"
proof -
from assms
obtain θ p where "pâG" "â¨Î¸,pâ©âÏ" "val(P,G,θ) = x"
using elem_of_val_pair by blast
moreover from this â¹ÏâMâº
have "θâM"
using pair_in_M_iff[THEN iffD1, THEN conjunct1, simplified]
transitivity by blast
ultimately
show ?thesis
by blast
qed
lemma GenExtD: "x â M[G] â¹ âÏâM. x = val(P,G,Ï)"
by (simp add:GenExt_def)
lemma GenExtI: "x â M â¹ val(P,G,x) â M[G]"
by (auto simp add: GenExt_def)
lemma Transset_MG : "Transset(M[G])"
proof -
{ fix vc y
assume "vc â M[G]" and "y â vc"
then
obtain c where "câM" "val(P,G,c)âM[G]" "y â val(P,G,c)"
using GenExtD by auto
from â¹y â val(P,G,c)âº
obtain θ where "θâdomain(c)" "val(P,G,θ) = y"
using elem_of_val by blast
with trans_M â¹câMâº
have "y â M[G]"
using domain_trans GenExtI by blast
}
then
show ?thesis
using Transset_def by auto
qed
lemmas transitivity_MG = Transset_intf[OF Transset_MG]
textâ¹This lemma can be proved before having \<^term>â¹check_in_Mâº. At some point Miguel naïvely
thought that the \<^term>â¹check_in_M⺠could be proved using this argument.âº
lemma check_nat_M :
assumes "n â nat"
shows "check(n) â M"
using assms
proof (induct n)
case 0
then
show ?case
using zero_in_M by (subst def_check,simp)
next
case (succ x)
have "ð â M"
using one_in_P P_sub_M subsetD by simp
with â¹check(x)âMâº
have "â¨check(x),ðâ© â M"
using pair_in_M_iff by simp
then
have "{â¨check(x),ðâ©} â M"
using singleton_closed by simp
with â¹check(x)âMâº
have "check(x) ⪠{â¨check(x),ðâ©} â M"
using Un_closed by simp
then
show ?case
using â¹xânat⺠def_checkS by simp
qed
lemma def_PHcheck:
assumes
"zâM" "fâM"
shows
"Hcheck(z,f) = Replace(z,PHcheck(##M,ð,f))"
proof -
from assms
have "â¨f`x,ðâ© â M" "f`xâM" if "xâz" for x
using pair_in_M_iff one_in_M transitivity that apply_closed by simp_all
then
have "{y . x â z, y = â¨f ` x, ðâ©} = {y . x â z, y = â¨f ` x, ðâ© â§ yâM â§ f`xâM}"
by simp
then
show ?thesis
using â¹zâM⺠â¹fâM⺠transitivity
unfolding Hcheck_def PHcheck_def RepFun_def
by auto
qed
lemma wfrec_Hcheck :
assumes "XâM"
shows "wfrec_replacement(##M,is_Hcheck(##M,ð),rcheck(X))"
proof -
let ?f="Exists(And(pair_fm(1,0,2),
is_wfrec_fm(is_Hcheck_fm(8,2,1,0),4,1,0)))"
have "is_Hcheck(##M,ð,a,b,c) â·
sats(M,is_Hcheck_fm(8,2,1,0),[c,b,a,d,e,y,x,z,ð,rcheck(x)])"
if "aâM" "bâM" "câM" "dâM" "eâM" "yâM" "xâM" "zâM"
for a b c d e y x z
using that one_in_M â¹XâM⺠rcheck_in_M is_Hcheck_iff_sats zero_in_M
by simp
then
have "sats(M,is_wfrec_fm(is_Hcheck_fm(8,2,1,0),4,1,0), [y,x,z,ð,rcheck(X)])
â· is_wfrec(##M, is_Hcheck(##M,ð),rcheck(X), x, y)"
if "xâM" "yâM" "zâM" for x y z
using that sats_is_wfrec_fm â¹XâM⺠rcheck_in_M one_in_M zero_in_M
by simp
moreover from this
have satsf:"sats(M, ?f, [x,z,ð,rcheck(X)]) â·
(âyâM. pair(##M,x,y,z) & is_wfrec(##M, is_Hcheck(##M,ð),rcheck(X), x, y))"
if "xâM" "zâM" for x z
using that â¹XâM⺠rcheck_in_M one_in_M
by (simp del:pair_abs)
moreover
have artyf:"arity(?f) = 4"
using arity_wfrec_replacement_fm[where p="is_Hcheck_fm(8, 2, 1, 0)" and i=9]
arity_is_Hcheck_fm ord_simp_union
by simp
ultimately
have "strong_replacement(##M,λx z. sats(M,?f,[x,z,ð,rcheck(X)]))"
using replacement_ax1(10) artyf â¹XâM⺠rcheck_in_M one_in_M
unfolding replacement_assm_def by simp
then
have "strong_replacement(##M,λx z.
âyâM. pair(##M,x,y,z) & is_wfrec(##M, is_Hcheck(##M,ð),rcheck(X), x, y))"
using repl_sats[of M ?f "[ð,rcheck(X)]"] satsf by (simp del:pair_abs)
then
show ?thesis
unfolding wfrec_replacement_def by simp
qed
lemma repl_PHcheck :
assumes "fâM"
shows "strong_replacement(##M,PHcheck(##M,ð,f))"
proof -
from â¹fâMâº
have "strong_replacement(##M,λx y. sats(M,PHcheck_fm(2,3,0,1),[x,y,ð,f]))"
using replacement_ax1(11) one_in_M unfolding replacement_assm_def
by (simp add:arity ord_simp_union)
with â¹fâMâº
show ?thesis
using one_in_M zero_in_M
unfolding strong_replacement_def univalent_def
by simp
qed
lemma univ_PHcheck : "⦠zâM ; fâM â§ â¹ univalent(##M,z,PHcheck(##M,ð,f))"
unfolding univalent_def PHcheck_def
by simp
lemma PHcheck_closed : "â¦zâM ; fâM ; xâz; PHcheck(##M,ð,f,x,y) â§ â¹ (##M)(y)"
unfolding PHcheck_def by simp
lemma relation2_Hcheck : "relation2(##M,is_Hcheck(##M,ð),Hcheck)"
proof -
have "is_Replace(##M,z,PHcheck(##M,ð,f),hc) â· hc = Replace(z,PHcheck(##M,ð,f))"
if "zâM" "fâM" "hcâM" for z f hc
using that Replace_abs[OF _ _ univ_PHcheck] PHcheck_closed[of z f]
by simp
with def_PHcheck
show ?thesis
unfolding relation2_def is_Hcheck_def Hcheck_def
by simp
qed
lemma Hcheck_closed : "âyâM. âgâM. function(g) â¶ Hcheck(y,g)âM"
proof -
have "Replace(y,PHcheck(##M,ð,f))âM" if "fâM" "yâM" for f y
using that repl_PHcheck PHcheck_closed[of y f] univ_PHcheck
strong_replacement_closed
by (simp flip: setclass_iff)
then
show ?thesis
using def_PHcheck by auto
qed
lemma wf_rcheck : "xâM â¹ wf(rcheck(x))"
unfolding rcheck_def using wf_trancl[OF wf_Memrel] .
lemma trans_rcheck : "xâM â¹ trans(rcheck(x))"
unfolding rcheck_def using trans_trancl .
lemma relation_rcheck : "xâM â¹ relation(rcheck(x))"
unfolding rcheck_def using relation_trancl .
lemma check_in_M : "xâM â¹ check(x) â M"
unfolding transrec_def
using wfrec_Hcheck[of x] check_trancl wf_rcheck trans_rcheck relation_rcheck rcheck_in_M
Hcheck_closed relation2_Hcheck trans_wfrec_closed[of "rcheck(x)" x "is_Hcheck(##M,ð)" Hcheck]
by (simp flip: setclass_iff)
lemma rcheck_abs[Rel] : "⦠xâM ; râM â§ â¹ is_rcheck(##M,x,r) â· r = rcheck(x)"
unfolding rcheck_def is_rcheck_def
using singleton_closed trancl_closed Memrel_closed eclose_closed zero_in_M
by simp
lemma check_abs[Rel] :
assumes "xâM" "zâM"
shows "is_check(##M,ð,x,z) â· z = check(x)"
proof -
have "is_check(##M,ð,x,z) â· is_wfrec(##M,is_Hcheck(##M,ð),rcheck(x),x,z)"
unfolding is_check_def
using assms rcheck_abs rcheck_in_M zero_in_M
unfolding check_trancl is_check_def
by simp
then
show ?thesis
unfolding check_trancl
using assms wfrec_Hcheck[of x] wf_rcheck trans_rcheck relation_rcheck rcheck_in_M
Hcheck_closed relation2_Hcheck trans_wfrec_abs[of "rcheck(x)" x z "is_Hcheck(##M,ð)" Hcheck]
by (simp flip: setclass_iff)
qed
lemma check_replacement: "{check(x). xâP} â M"
proof -
have "arity(check_fm(0,2,1)) = 3"
by (simp add:ord_simp_union arity)
then
show ?thesis
using sats_check_fm check_abs P_in_M check_in_M one_in_M transitivity zero_in_M
Replace_relativized_in_M[of "check_fm(0,2,1)" "[ð]" _ "is_check(##M,ð)" check]
check_fm_type replacement_ax1(12)
by simp
qed
lemma M_subset_MG : "ð â G â¹ M â M[G]"
using check_in_M one_in_P GenExtI
by (intro subsetI, subst valcheck [of G,symmetric], auto)
textâ¹The name for the generic filterâº
definition
G_dot :: "i" where
"G_dot â¡ {â¨check(p),pâ© . pâP}"
lemma G_dot_in_M : "G_dot â M"
proof -
let ?is_pcheck = "λx y. âchâM. is_check(##M,ð,x,ch) â§ pair(##M,ch,x,y)"
let ?pcheck_fm = "Exists(And(check_fm(1,3,0),pair_fm(0,1,2)))"
have "sats(M,?pcheck_fm,[x,y,ð]) â· ?is_pcheck(x,y)" if "xâM" "yâM" for x y
using sats_check_fm that one_in_M zero_in_M by simp
moreover
have "?is_pcheck(x,y) â· y = â¨check(x),xâ©" if "xâM" "yâM" for x y
using that check_abs check_in_M by simp
moreover
have "?pcheck_fmâformula"
by simp
moreover
have "arity(?pcheck_fm)=3"
by (simp add:ord_simp_union arity)
moreover
from P_in_M check_in_M pair_in_M_iff P_sub_M
have "â¨check(p),pâ© â M" if "pâP" for p
using that by auto
ultimately
show ?thesis
unfolding G_dot_def
using one_in_M P_in_M transitivity Replace_relativized_in_M[of ?pcheck_fm "[ð]"]
replacement_ax1(13)
by simp
qed
lemma val_G_dot :
assumes "G â P" "ð â G"
shows "val(P,G,G_dot) = G"
proof (intro equalityI subsetI)
fix x
assume "xâval(P,G,G_dot)"
then obtain θ p where "pâG" "â¨Î¸,pâ© â G_dot" "val(P,G,θ) = x" "θ = check(p)"
unfolding G_dot_def using elem_of_val_pair G_dot_in_M
by force
with â¹ðâG⺠â¹GâPâº
show "x â G"
using valcheck P_sub_M by auto
next
fix p
assume "pâG"
have "â¨check(q),qâ© â G_dot" if "qâP" for q
unfolding G_dot_def using that by simp
with â¹pâG⺠â¹GâPâº
have "val(P,G,check(p)) â val(P,G,G_dot)"
using val_of_elem G_dot_in_M by blast
with â¹pâG⺠â¹GâP⺠â¹ðâGâº
show "p â val(P,G,G_dot)"
using P_sub_M valcheck by auto
qed
lemma G_in_Gen_Ext :
assumes "G â P" "ð â G"
shows "G â M[G]"
using assms val_G_dot GenExtI[of _ G] G_dot_in_M
by force
end
locale G_generic1 = forcing_data1 +
fixes G :: "i"
assumes generic : "M_generic(G)"
begin
lemma zero_in_MG :
"0 â M[G]"
proof -
have "0 = val(P,G,0)"
using zero_in_M elem_of_val by auto
also
have "... â M[G]"
using GenExtI zero_in_M by simp
finally
show ?thesis .
qed
lemma G_nonempty: "Gâ 0"
using generic subset_refl[of P] P_in_M P_dense
unfolding M_generic_def
by auto
end
locale G_generic1_AC = G_generic1 + M_ctm1_AC
end
Theory Forcing_Theorems
sectionâ¹The Forcing Theoremsâº
theory Forcing_Theorems
imports
Cohen_Posets_Relative
Forces_Definition
Names
begin
context forcing_data1
begin
subsectionâ¹The forcing relation in contextâº
lemma separation_forces :
assumes
fty: "Ïâformula" and
far: "arity(Ï)â¤length(env)" and
envty: "envâlist(M)"
shows
"separation(##M,λp. (p â© Ï env))"
using separation_ax arity_forces far fty P_in_M leq_in_M one_in_M envty arity_forces_le
transitivity[of _ P]
by simp
lemma Collect_forces :
assumes
"Ïâformula" and
"arity(Ï)â¤length(env)" and
"envâlist(M)"
shows
"{pâP . p â© Ï env} â M"
using assms separation_forces separation_closed P_in_M
by simp
lemma forces_mem_iff_dense_below: "pâP â¹ p forcesâ©a (t1 â t2) â· dense_below(
{qâP. âs. âr. râP â§ â¨s,râ© â t2 â§ qâ¼r â§ q forcesâ©a (t1 = s)}
,p)"
using def_forces_mem[of p t1 t2] by blast
subsectionâ¹Kunen 2013, Lemma IV.2.37(a)âº
lemma strengthening_eq:
assumes "pâP" "râP" "râ¼p" "p forcesâ©a (t1 = t2)"
shows "r forcesâ©a (t1 = t2)"
using assms def_forces_eq[of _ t1 t2] leq_transD by blast
subsectionâ¹Kunen 2013, Lemma IV.2.37(a)âº
lemma strengthening_mem:
assumes "pâP" "râP" "râ¼p" "p forcesâ©a (t1 â t2)"
shows "r forcesâ©a (t1 â t2)"
using assms forces_mem_iff_dense_below dense_below_under by auto
subsectionâ¹Kunen 2013, Lemma IV.2.37(b)âº
lemma density_mem:
assumes "pâP"
shows "p forcesâ©a (t1 â t2) â· dense_below({qâP. q forcesâ©a (t1 â t2)},p)"
proof
assume "p forcesâ©a (t1 â t2)"
with assms
show "dense_below({qâP. q forcesâ©a (t1 â t2)},p)"
using forces_mem_iff_dense_below strengthening_mem[of p] ideal_dense_below by auto
next
assume "dense_below({q â P . q forcesâ©a ( t1 â t2)}, p)"
with assms
have "dense_below({qâP.
dense_below({q'âP. âs r. r â P â§ â¨s,râ©ât2 â§ q'â¼r â§ q' forcesâ©a (t1 = s)},q)
},p)"
using forces_mem_iff_dense_below by simp
with assms
show "p forcesâ©a (t1 â t2)"
using dense_below_dense_below forces_mem_iff_dense_below[of p t1 t2] by blast
qed
lemma aux_density_eq:
assumes
"dense_below(
{q'âP. âq. qâP â§ qâ¼q' â¶ q forcesâ©a (s â t1) â· q forcesâ©a (s â t2)}
,p)"
"q forcesâ©a (s â t1)" "qâP" "pâP" "qâ¼p"
shows
"dense_below({râP. r forcesâ©a (s â t2)},q)"
proof
fix r
assume "râP" "râ¼q"
moreover from this and â¹pâP⺠â¹qâ¼p⺠â¹qâPâº
have "râ¼p"
using leq_transD by simp
moreover
note â¹q forcesâ©a (s â t1)⺠â¹dense_below(_,p)⺠â¹qâPâº
ultimately
obtain q1 where "q1â¼r" "q1âP" "q1 forcesâ©a (s â t2)"
using strengthening_mem[of q _ s t1] refl_leq leq_transD[of _ r q] by blast
then
show "âdâ{r â P . r forcesâ©a ( s â t2)}. d â P â§ dâ¼ r"
by blast
qed
lemma density_eq:
assumes "pâP"
shows "p forcesâ©a (t1 = t2) â· dense_below({qâP. q forcesâ©a (t1 = t2)},p)"
proof
assume "p forcesâ©a (t1 = t2)"
with â¹pâPâº
show "dense_below({qâP. q forcesâ©a (t1 = t2)},p)"
using strengthening_eq ideal_dense_below by auto
next
assume "dense_below({qâP. q forcesâ©a (t1 = t2)},p)"
{
fix s q
let ?D1="{q'âP. âsâdomain(t1) ⪠domain(t2). âq. q â P â§ qâ¼q' â¶
q forcesâ©a (s â t1)â·q forcesâ©a (s â t2)}"
let ?D2="{q'âP. âq. qâP â§ qâ¼q' â¶ q forcesâ©a (s â t1) â· q forcesâ©a (s â t2)}"
assume "sâdomain(t1) ⪠domain(t2)"
then
have "?D1â?D2" by blast
with â¹dense_below(_,p)âº
have "dense_below({q'âP. âsâdomain(t1) ⪠domain(t2). âq. q â P â§ qâ¼q' â¶
q forcesâ©a (s â t1)â·q forcesâ©a (s â t2)},p)"
using dense_below_cong'[OF â¹pâP⺠def_forces_eq[of _ t1 t2]] by simp
with â¹pâP⺠â¹?D1â?D2âº
have "dense_below({q'âP. âq. qâP â§ qâ¼q' â¶
q forcesâ©a (s â t1) â· q forcesâ©a (s â t2)},p)"
using dense_below_mono by simp
moreover from this
have "dense_below({q'âP. âq. qâP â§ qâ¼q' â¶
q forcesâ©a (s â t2) â· q forcesâ©a (s â t1)},p)"
by blast
moreover
assume "q â P" "qâ¼p"
moreover
note â¹pâPâº
ultimately
have "q forcesâ©a (s â t1) â¹ dense_below({râP. r forcesâ©a (s â t2)},q)"
"q forcesâ©a (s â t2) â¹ dense_below({râP. r forcesâ©a (s â t1)},q)"
using aux_density_eq by simp_all
then
have "q forcesâ©a ( s â t1) â· q forcesâ©a ( s â t2)"
using density_mem[OF â¹qâPâº] by blast
}
with â¹pâPâº
show "p forcesâ©a (t1 = t2)" using def_forces_eq by blast
qed
subsectionâ¹Kunen 2013, Lemma IV.2.38âº
lemma not_forces_neq:
assumes "pâP"
shows "p forcesâ©a (t1 = t2) ⷠ¬ (âqâP. qâ¼p â§ q forcesâ©a (t1 â t2))"
using assms density_eq unfolding forces_neq_def by blast
lemma not_forces_nmem:
assumes "pâP"
shows "p forcesâ©a (t1 â t2) ⷠ¬ (âqâP. qâ¼p â§ q forcesâ©a (t1 â t2))"
using assms density_mem unfolding forces_nmem_def by blast
subsectionâ¹The relation of forcing and atomic formulasâº
lemma Forces_Equal:
assumes
"pâP" "t1âM" "t2âM" "envâlist(M)" "nth(n,env) = t1" "nth(m,env) = t2" "nânat" "mânat"
shows
"(p â© Equal(n,m) env) â· p forcesâ©a (t1 = t2)"
using assms sats_forces_Equal forces_eq_abs transitivity P_in_M
by simp
lemma Forces_Member:
assumes
"pâP" "t1âM" "t2âM" "envâlist(M)" "nth(n,env) = t1" "nth(m,env) = t2" "nânat" "mânat"
shows
"(p â© Member(n,m) env) â· p forcesâ©a (t1 â t2)"
using assms sats_forces_Member forces_mem_abs transitivity P_in_M
by simp
lemma Forces_Neg:
assumes
"pâP" "env â list(M)" "Ïâformula"
shows
"(p â© Neg(Ï) env) ⷠ¬(âqâM. qâP â§ qâ¼p â§ (q â© Ï env))"
using assms sats_forces_Neg transitivity P_in_M pair_in_M_iff leq_in_M leq_abs
by simp
subsectionâ¹The relation of forcing and connectivesâº
lemma Forces_Nand:
assumes
"pâP" "env â list(M)" "Ïâformula" "Ïâformula"
shows
"(p â© Nand(Ï,Ï) env) ⷠ¬(âqâM. qâP â§ qâ¼p â§ (q â© Ï env) â§ (q â© Ï env))"
using assms sats_forces_Nand transitivity
P_in_M pair_in_M_iff leq_in_M leq_abs by simp
lemma Forces_And_aux:
assumes
"pâP" "env â list(M)" "Ïâformula" "Ïâformula"
shows
"p â© And(Ï,Ï) env â·
(âqâM. qâP â§ qâ¼p â¶ (ârâM. râP â§ râ¼q â§ (r â© Ï env) â§ (r â© Ï env)))"
unfolding And_def using assms Forces_Neg Forces_Nand by (auto simp only:)
lemma Forces_And_iff_dense_below:
assumes
"pâP" "env â list(M)" "Ïâformula" "Ïâformula"
shows
"(p â© And(Ï,Ï) env) â· dense_below({râP. (r â© Ï env) â§ (r â© Ï env) },p)"
unfolding dense_below_def using Forces_And_aux assms
by (auto dest:transitivity[OF _ P_in_M]; rename_tac q; drule_tac x=q in bspec)+
lemma Forces_Forall:
assumes
"pâP" "env â list(M)" "Ïâformula"
shows
"(p â© Forall(Ï) env) â· (âxâM. (p â© Ï ([x] @ env)))"
using sats_forces_Forall assms transitivity[OF _ P_in_M]
by simp
bundle some_rules = elem_of_val_pair [dest]
context
includes some_rules
begin
lemma elem_of_valI: "âθ. âpâP. pâG â§ â¨Î¸,pâ©âÏ â§ val(P,G,θ) = x â¹ xâval(P,G,Ï)"
by (subst def_val, auto)
lemma GenExt_iff: "xâM[G] â· (âÏâM. x = val(P,G,Ï))"
unfolding GenExt_def by simp
subsectionâ¹Kunen 2013, Lemma IV.2.29âº
lemma generic_inter_dense_below:
assumes "DâM" "M_generic(G)" "dense_below(D,p)" "pâG"
shows "D â© G â 0"
proof -
let ?D="{qâP. pâ¥q ⨠qâD}"
have "dense(?D)"
proof
fix r
assume "râP"
show "âdâ{q â P . p ⥠q ⨠q â D}. d â¼ r"
proof (cases "p ⥠r")
case True
with â¹râPâº
show ?thesis using refl_leq[of r] by (intro bexI) (blast+)
next
case False
then
obtain s where "sâP" "sâ¼p" "sâ¼r" by blast
with assms â¹râPâº
show ?thesis
using dense_belowD[OF assms(3), of s] leq_transD[of _ s r]
by blast
qed
qed
have "?DâP" by auto
let ?d_fm="â
â
¬compat_in_fm(1, 2, 3, 0) â
⨠â
0 â 4â
â
"
have 1:"pâM"
using â¹M_generic(G)⺠M_genericD transitivity[OF _ P_in_M]
â¹pâG⺠by simp
moreover
have "?d_fmâformula" by simp
moreover
have "arity(?d_fm) = 5"
by (auto simp add: arity)
moreover
have "(M, [q,P,leq,p,D] ⨠?d_fm) â· (¬ is_compat_in(##M,P,leq,p,q) ⨠qâD)"
if "qâM" for q
using that sats_compat_in_fm P_in_M leq_in_M 1 â¹DâM⺠zero_in_M
by simp
moreover
have "(¬ is_compat_in(##M,P,leq,p,q) ⨠qâD) â· pâ¥q ⨠qâD" if "qâM" for q
unfolding compat_def
using that compat_in_abs P_in_M leq_in_M 1
by simp
ultimately
have "?DâM"
using Collect_in_M[of ?d_fm "[P,leq,p,D]"] P_in_M leq_in_M â¹DâMâº
by simp
note asm = â¹M_generic(G)⺠â¹dense(?D)⺠â¹?DâP⺠â¹?DâMâº
obtain x where "xâG" "xâ?D" using M_generic_denseD[OF asm]
by force
moreover from this and â¹M_generic(G)âº
have "xâD"
using M_generic_compatD[OF _ â¹pâGâº, of x] refl_leq compatI[of _ p x]
by force
ultimately
show ?thesis by auto
qed
subsectionâ¹Auxiliary results for Lemma IV.2.40(a)âº
lemma IV240a_mem_Collect:
assumes
"ÏâM" "ÏâM"
shows
"{qâP. âÏ. âr. râP â§ â¨Ï,râ© â Ï â§ qâ¼r â§ q forcesâ©a (Ï = Ï)}âM"
proof -
let ?rel_pred= "λM x a1 a2 a3 a4. âÏ[M]. âr[M]. âÏr[M].
râa1 â§ pair(M,Ï,r,Ïr) â§ Ïrâa4 â§ is_leq(M,a2,x,r) â§ is_forces_eq'(M,a1,a2,x,a3,Ï)"
let ?Ï="Exists(Exists(Exists(And(Member(1,4),And(pair_fm(2,1,0),
And(Member(0,7),And(is_leq_fm(5,3,1),forces_eq_fm(4,5,3,6,2))))))))"
have "ÏâM â§ râM" if "â¨Ï, râ© â Ï" for Ï r
using that â¹ÏâM⺠pair_in_M_iff transitivity[of "â¨Ï,râ©" Ï] by simp
then
have "?rel_pred(##M,q,P,leq,Ï,Ï) â· (âÏ. âr. râP â§ â¨Ï,râ© â Ï â§ qâ¼r â§ q forcesâ©a (Ï = Ï))"
if "qâM" for q
unfolding forces_eq_def
using assms that P_in_M leq_in_M leq_abs forces_eq'_abs pair_in_M_iff
by auto
moreover
have "(M, [q,P,leq,Ï,Ï] ⨠?Ï) â· ?rel_pred(##M,q,P,leq,Ï,Ï)" if "qâM" for q
using assms that sats_forces_eq_fm sats_is_leq_fm P_in_M leq_in_M zero_in_M
by simp
moreover
have "?Ïâformula" by simp
moreover
have "arity(?Ï)=5"
using arity_forces_eq_fm
by (simp add:ord_simp_union arity)
ultimately
show ?thesis
unfolding forces_eq_def using P_in_M leq_in_M assms Collect_in_M[of ?Ï "[P,leq,Ï,Ï]"]
by simp
qed
lemma IV240a_mem:
assumes
"M_generic(G)" "pâG" "ÏâM" "ÏâM" "p forcesâ©a (Ï â Ï)"
"âq Ï. qâP â¹ qâG â¹ Ïâdomain(Ï) â¹ q forcesâ©a (Ï = Ï) â¹
val(P,G,Ï) = val(P,G,Ï)"
shows
"val(P,G,Ï)âval(P,G,Ï)"
proof (intro elem_of_valI)
let ?D="{qâP. âÏ. âr. râP â§ â¨Ï,râ© â Ï â§ qâ¼r â§ q forcesâ©a (Ï = Ï)}"
from â¹M_generic(G)⺠â¹pâGâº
have "pâP" by blast
moreover
note â¹ÏâM⺠â¹ÏâMâº
ultimately
have "?D â M" using IV240a_mem_Collect by simp
moreover from assms â¹pâPâº
have "dense_below(?D,p)"
using forces_mem_iff_dense_below by simp
moreover
note â¹M_generic(G)⺠â¹pâGâº
ultimately
obtain q where "qâG" "qâ?D" using generic_inter_dense_below by blast
then
obtain Ï r where "râP" "â¨Ï,râ© â Ï" "qâ¼r" "q forcesâ©a (Ï = Ï)" by blast
moreover from this and â¹qâG⺠assms
have "r â G" "val(P,G,Ï) = val(P,G,Ï)" by blast+
ultimately
show "â Ï. âpâP. p â G â§ â¨Ï, pâ© â Ï â§ val(P,G, Ï) = val(P,G, Ï)" by auto
qed
lemma refl_forces_eq:"pâP â¹ p forcesâ©a (x = x)"
using def_forces_eq by simp
lemma forces_memI: "â¨Ï,râ©âÏ â¹ pâP â¹ râP â¹ pâ¼r â¹ p forcesâ©a (Ï â Ï)"
using refl_forces_eq[of _ Ï] leq_transD refl_leq
by (blast intro:forces_mem_iff_dense_below[THEN iffD2])
lemma IV240a_eq_1st_incl:
assumes
"M_generic(G)" "pâG" "p forcesâ©a (Ï = θ)"
and
IH:"âq Ï. qâP â¹ qâG â¹ Ïâdomain(Ï) ⪠domain(θ) â¹
(q forcesâ©a (Ï â Ï) â¶ val(P,G,Ï) â val(P,G,Ï)) â§
(q forcesâ©a (Ï â θ) â¶ val(P,G,Ï) â val(P,G,θ))"
shows
"val(P,G,Ï) â val(P,G,θ)"
proof
fix x
assume "xâval(P,G,Ï)"
then
obtain Ï r where "â¨Ï,râ©âÏ" "râG" "val(P,G,Ï)=x" by blast
moreover from this and â¹pâG⺠â¹M_generic(G)âº
obtain q where "qâG" "qâ¼p" "qâ¼r" by force
moreover from this and â¹pâG⺠â¹M_generic(G)âº
have "qâP" "pâP" by blast+
moreover from calculation and â¹M_generic(G)âº
have "q forcesâ©a (Ï â Ï)"
using forces_memI by blast
moreover
note â¹p forcesâ©a (Ï = θ)âº
ultimately
have "q forcesâ©a (Ï â θ)"
using def_forces_eq by blast
with â¹qâP⺠â¹qâG⺠IH[of q Ï] â¹â¨Ï,râ©âÏ⺠â¹val(P,G,Ï) = xâº
show "xâval(P,G,θ)" by (blast)
qed
lemma IV240a_eq_2nd_incl:
assumes
"M_generic(G)" "pâG" "p forcesâ©a (Ï = θ)"
and
IH:"âq Ï. qâP â¹ qâG â¹ Ïâdomain(Ï) ⪠domain(θ) â¹
(q forcesâ©a (Ï â Ï) â¶ val(P,G,Ï) â val(P,G,Ï)) â§
(q forcesâ©a (Ï â θ) â¶ val(P,G,Ï) â val(P,G,θ))"
shows
"val(P,G,θ) â val(P,G,Ï)"
proof
fix x
assume "xâval(P,G,θ)"
then
obtain Ï r where "â¨Ï,râ©âθ" "râG" "val(P,G,Ï)=x" by blast
moreover from this and â¹pâG⺠â¹M_generic(G)âº
obtain q where "qâG" "qâ¼p" "qâ¼r" by force
moreover from this and â¹pâG⺠â¹M_generic(G)âº
have "qâP" "pâP" by blast+
moreover from calculation and â¹M_generic(G)âº
have "q forcesâ©a (Ï â θ)"
using forces_memI by blast
moreover
note â¹p forcesâ©a (Ï = θ)âº
ultimately
have "q forcesâ©a (Ï â Ï)"
using def_forces_eq by blast
with â¹qâP⺠â¹qâG⺠IH[of q Ï] â¹â¨Ï,râ©âθ⺠â¹val(P,G,Ï) = xâº
show "xâval(P,G,Ï)" by (blast)
qed
lemma IV240a_eq:
assumes
"M_generic(G)" "pâG" "p forcesâ©a (Ï = θ)"
and
IH:"âq Ï. qâP â¹ qâG â¹ Ïâdomain(Ï) ⪠domain(θ) â¹
(q forcesâ©a (Ï â Ï) â¶ val(P,G,Ï) â val(P,G,Ï)) â§
(q forcesâ©a (Ï â θ) â¶ val(P,G,Ï) â val(P,G,θ))"
shows
"val(P,G,Ï) = val(P,G,θ)"
using IV240a_eq_1st_incl[OF assms] IV240a_eq_2nd_incl[OF assms] IH by blast
subsectionâ¹Induction on namesâº
lemma core_induction:
assumes
"âÏ Î¸ p. p â P â¹ â¦âq Ï. â¦qâP ; Ïâdomain(θ)â§ â¹ Q(0,Ï,Ï,q)â§ â¹ Q(1,Ï,θ,p)"
"âÏ Î¸ p. p â P â¹ â¦âq Ï. â¦qâP ; Ïâdomain(Ï) ⪠domain(θ)â§ â¹ Q(1,Ï,Ï,q) â§ Q(1,Ï,θ,q)â§ â¹ Q(0,Ï,θ,p)"
"ft â 2" "p â P"
shows
"Q(ft,Ï,θ,p)"
proof -
{
fix ft p Ï Î¸
have "Transset(eclose({Ï,θ}))" (is "Transset(?e)")
using Transset_eclose by simp
have "Ï â ?e" "θ â ?e"
using arg_into_eclose by simp_all
moreover
assume "ft â 2" "p â P"
ultimately
have "â¨ft,Ï,θ,pâ©â 2Ã?eÃ?eÃP" (is "?aâ2Ã?eÃ?eÃP") by simp
then
have "Q(ftype(?a), name1(?a), name2(?a), cond_of(?a))"
using core_induction_aux[of ?e P Q ?a,OF â¹Transset(?e)⺠assms(1,2) â¹?aâ_âº]
by (clarify) (blast)
then have "Q(ft,Ï,θ,p)" by (simp add:components_simp)
}
then show ?thesis using assms by simp
qed
lemma forces_induction_with_conds:
assumes
"âÏ Î¸ p. p â P â¹ â¦âq Ï. â¦qâP ; Ïâdomain(θ)â§ â¹ Q(q,Ï,Ï)â§ â¹ R(p,Ï,θ)"
"âÏ Î¸ p. p â P â¹ â¦âq Ï. â¦qâP ; Ïâdomain(Ï) ⪠domain(θ)â§ â¹ R(q,Ï,Ï) â§ R(q,Ï,θ)â§ â¹ Q(p,Ï,θ)"
"p â P"
shows
"Q(p,Ï,θ) â§ R(p,Ï,θ)"
proof -
let ?Q="λft Ï Î¸ p. (ft = 0 â¶ Q(p,Ï,θ)) â§ (ft = 1 â¶ R(p,Ï,θ))"
from assms(1)
have "âÏ Î¸ p. p â P â¹ â¦âq Ï. â¦qâP ; Ïâdomain(θ)â§ â¹ ?Q(0,Ï,Ï,q)â§ â¹ ?Q(1,Ï,θ,p)"
by simp
moreover from assms(2)
have "âÏ Î¸ p. p â P â¹ â¦âq Ï. â¦qâP ; Ïâdomain(Ï) ⪠domain(θ)â§ â¹ ?Q(1,Ï,Ï,q) â§ ?Q(1,Ï,θ,q)â§ â¹ ?Q(0,Ï,θ,p)"
by simp
moreover
note â¹pâPâº
ultimately
have "?Q(ft,Ï,θ,p)" if "ftâ2" for ft
by (rule core_induction[OF _ _ that, of ?Q])
then
show ?thesis by auto
qed
lemma forces_induction:
assumes
"âÏ Î¸. â¦âÏ. Ïâdomain(θ) â¹ Q(Ï,Ï)â§ â¹ R(Ï,θ)"
"âÏ Î¸. â¦âÏ. Ïâdomain(Ï) ⪠domain(θ) â¹ R(Ï,Ï) â§ R(Ï,θ)â§ â¹ Q(Ï,θ)"
shows
"Q(Ï,θ) â§ R(Ï,θ)"
proof (intro forces_induction_with_conds[OF _ _ one_in_P ])
fix Ï Î¸ p
assume "q â P â¹ Ï â domain(θ) â¹ Q(Ï, Ï)" for q Ï
with assms(1)
show "R(Ï,θ)"
using one_in_P by simp
next
fix Ï Î¸ p
assume "q â P â¹ Ï â domain(Ï) ⪠domain(θ) â¹ R(Ï,Ï) â§ R(Ï,θ)" for q Ï
with assms(2)
show "Q(Ï,θ)"
using one_in_P by simp
qed
subsectionâ¹Lemma IV.2.40(a), in fullâº
lemma IV240a:
assumes
"M_generic(G)"
shows
"(ÏâM ⶠθâM â¶ (âpâG. p forcesâ©a (Ï = θ) â¶ val(P,G,Ï) = val(P,G,θ))) â§
(ÏâM ⶠθâM â¶ (âpâG. p forcesâ©a (Ï â θ) â¶ val(P,G,Ï) â val(P,G,θ)))"
(is "?Q(Ï,θ) â§ ?R(Ï,θ)")
proof (intro forces_induction[of ?Q ?R] impI)
fix Ï Î¸
assume "ÏâM" "θâM" "Ïâdomain(θ) â¹ ?Q(Ï,Ï)" for Ï
moreover from this
have "Ïâdomain(θ) â¹ q forcesâ©a (Ï = Ï) â¹ val(P,G, Ï) = val(P,G, Ï)"
if "qâP" "qâG" for q Ï
using that domain_closed[of θ] transitivity by auto
moreover
note assms
ultimately
show "âpâG. p forcesâ©a (Ï â θ) â¶ val(P,G,Ï) â val(P,G,θ)"
using IV240a_mem domain_closed transitivity by (simp)
next
fix Ï Î¸
assume "ÏâM" "θâM" "Ï â domain(Ï) ⪠domain(θ) â¹ ?R(Ï,Ï) â§ ?R(Ï,θ)" for Ï
moreover from this
have IH':"Ï â domain(Ï) ⪠domain(θ) â¹ qâG â¹
(q forcesâ©a (Ï â Ï) â¶ val(P,G, Ï) â val(P,G, Ï)) â§
(q forcesâ©a (Ï â θ) â¶ val(P,G, Ï) â val(P,G, θ))" for q Ï
by (auto intro: transitivity[OF _ domain_closed[simplified]])
ultimately
show "âpâG. p forcesâ©a (Ï = θ) â¶ val(P,G,Ï) = val(P,G,θ)"
using IV240a_eq[OF assms(1) _ _ IH'] by (simp)
qed
subsectionâ¹Lemma IV.2.40(b)âº
lemma IV240b_mem:
assumes
"M_generic(G)" "val(P,G,Ï)âval(P,G,Ï)" "ÏâM" "ÏâM"
and
IH:"âÏ. Ïâdomain(Ï) â¹ val(P,G,Ï) = val(P,G,Ï) â¹
âpâG. p forcesâ©a (Ï = Ï)"
shows
"âpâG. p forcesâ©a (Ï â Ï)"
proof -
from â¹val(P,G,Ï)âval(P,G,Ï)âº
obtain Ï r where "râG" "â¨Ï,râ©âÏ" "val(P,G,Ï) = val(P,G,Ï)" by auto
moreover from this and IH
obtain p' where "p'âG" "p' forcesâ©a (Ï = Ï)" by blast
moreover
note â¹M_generic(G)âº
ultimately
obtain p where "pâ¼r" "pâG" "p forcesâ©a (Ï = Ï)"
using M_generic_compatD strengthening_eq[of p'] by blast
moreover
note â¹M_generic(G)âº
moreover from calculation
have "q forcesâ©a (Ï = Ï)" if "qâP" "qâ¼p" for q
using that strengthening_eq by blast
moreover
note â¹â¨Ï,râ©âÏ⺠â¹râGâº
ultimately
have "râP â§ â¨Ï,râ© â Ï â§ qâ¼r â§ q forcesâ©a (Ï = Ï)" if "qâP" "qâ¼p" for q
using that leq_transD[of _ p r] by blast
then
have "dense_below({qâP. âs r. râP â§ â¨s,râ© â Ï â§ qâ¼r â§ q forcesâ©a (Ï = s)},p)"
using refl_leq by blast
moreover
note â¹M_generic(G)⺠â¹pâGâº
moreover from calculation
have "p forcesâ©a (Ï â Ï)"
using forces_mem_iff_dense_below by blast
ultimately
show ?thesis by blast
qed
end
lemma Collect_forces_eq_in_M:
assumes "Ï â M" "θ â M"
shows "{pâP. p forcesâ©a (Ï = θ)} â M"
using assms Collect_in_M[of "forces_eq_fm(1,2,0,3,4)" "[P,leq,Ï,θ]"]
arity_forces_eq_fm P_in_M leq_in_M sats_forces_eq_fm forces_eq_abs forces_eq_fm_type
by (simp add: union_abs1 Un_commute)
lemma IV240b_eq_Collects:
assumes "Ï â M" "θ â M"
shows "{pâP. âÏâdomain(Ï) ⪠domain(θ). p forcesâ©a (Ï â Ï) â§ p forcesâ©a (Ï â θ)}âM" and
"{pâP. âÏâdomain(Ï) ⪠domain(θ). p forcesâ©a (Ï â Ï) â§ p forcesâ©a (Ï â θ)}âM"
proof -
let ?rel_pred="λM x a1 a2 a3 a4.
âÏ[M]. âu[M]. âda3[M]. âda4[M]. is_domain(M,a3,da3) â§ is_domain(M,a4,da4) â§
union(M,da3,da4,u) â§ Ïâu â§ is_forces_mem'(M,a1,a2,x,Ï,a3) â§
is_forces_nmem'(M,a1,a2,x,Ï,a4)"
let ?Ï="Exists(Exists(Exists(Exists(And(domain_fm(7,1),And(domain_fm(8,0),
And(union_fm(1,0,2),And(Member(3,2),And(forces_mem_fm(5,6,4,3,7),
forces_nmem_fm(5,6,4,3,8))))))))))"
have 1:"ÏâM" if "â¨Ï,yâ©âδ" "δâM" for Ï Î´ y
using that pair_in_M_iff transitivity[of "â¨Ï,yâ©" δ] by simp
have abs1:"?rel_pred(##M,p,P,leq,Ï,θ) â·
(âÏâdomain(Ï) ⪠domain(θ). forces_mem'(P,leq,p,Ï,Ï) â§ forces_nmem'(P,leq,p,Ï,θ))"
if "pâM" for p
unfolding forces_mem_def forces_nmem_def
using assms that forces_mem'_abs forces_nmem'_abs P_in_M leq_in_M
domain_closed Un_closed
by (auto simp add:1[of _ _ Ï] 1[of _ _ θ])
have abs2:"?rel_pred(##M,p,P,leq,θ,Ï) â· (âÏâdomain(Ï) ⪠domain(θ).
forces_nmem'(P,leq,p,Ï,Ï) â§ forces_mem'(P,leq,p,Ï,θ))" if "pâM" for p
unfolding forces_mem_def forces_nmem_def
using assms that forces_mem'_abs forces_nmem'_abs P_in_M leq_in_M
domain_closed Un_closed
by (auto simp add:1[of _ _ Ï] 1[of _ _ θ])
have fsats1:"(M,[p,P,leq,Ï,θ] ⨠?Ï) â· ?rel_pred(##M,p,P,leq,Ï,θ)" if "pâM" for p
using that assms sats_forces_mem_fm sats_forces_nmem_fm P_in_M leq_in_M zero_in_M
domain_closed Un_closed by simp
have fsats2:"(M,[p,P,leq,θ,Ï] ⨠?Ï) â· ?rel_pred(##M,p,P,leq,θ,Ï)" if "pâM" for p
using that assms sats_forces_mem_fm sats_forces_nmem_fm P_in_M leq_in_M zero_in_M
domain_closed Un_closed by simp
have fty:"?Ïâformula" by simp
have farit:"arity(?Ï)=5"
by (simp add:ord_simp_union arity)
show
"{p â P . âÏâdomain(Ï) ⪠domain(θ). p forcesâ©a (Ï â Ï) â§ p forcesâ©a (Ï â θ)} â M"
and "{p â P . âÏâdomain(Ï) ⪠domain(θ). p forcesâ©a (Ï â Ï) â§ p forcesâ©a (Ï â θ)} â M"
unfolding forces_mem_def
using abs1 fty fsats1 farit P_in_M leq_in_M assms forces_nmem
Collect_in_M[of ?Ï "[P,leq,Ï,θ]"]
using abs2 fty fsats2 farit P_in_M leq_in_M assms forces_nmem domain_closed Un_closed
Collect_in_M[of ?Ï "[P,leq,θ,Ï]"]
by simp_all
qed
lemma IV240b_eq:
assumes
"M_generic(G)" "val(P,G,Ï) = val(P,G,θ)" "ÏâM" "θâM"
and
IH:"âÏ. Ïâdomain(Ï)âªdomain(θ) â¹
(val(P,G,Ï)âval(P,G,Ï) â¶ (âqâG. q forcesâ©a (Ï â Ï))) â§
(val(P,G,Ï)âval(P,G,θ) â¶ (âqâG. q forcesâ©a (Ï â θ)))"
shows
"âpâG. p forcesâ©a (Ï = θ)"
proof -
let ?D1="{pâP. p forcesâ©a (Ï = θ)}"
let ?D2="{pâP. âÏâdomain(Ï) ⪠domain(θ). p forcesâ©a (Ï â Ï) â§ p forcesâ©a (Ï â θ)}"
let ?D3="{pâP. âÏâdomain(Ï) ⪠domain(θ). p forcesâ©a (Ï â Ï) â§ p forcesâ©a (Ï â θ)}"
let ?D="?D1 ⪠?D2 ⪠?D3"
note assms
moreover from this
have "domain(Ï) ⪠domain(θ)âM" (is "?BâM") using domain_closed Un_closed by auto
moreover from calculation
have "?D2âM" and "?D3âM" using IV240b_eq_Collects by simp_all
ultimately
have "?DâM" using Collect_forces_eq_in_M Un_closed by auto
moreover
have "dense(?D)"
proof
fix p
assume "pâP"
have "âdâP. (d forcesâ©a (Ï = θ) â¨
(âÏâdomain(Ï) ⪠domain(θ). d forcesâ©a (Ï â Ï) â§ d forcesâ©a (Ï â θ)) â¨
(âÏâdomain(Ï) ⪠domain(θ). d forcesâ©a (Ï â Ï) â§ d forcesâ©a (Ï â θ))) â§
d â¼ p"
proof (cases "p forcesâ©a (Ï = θ)")
case True
with â¹pâPâº
show ?thesis using refl_leq by blast
next
case False
moreover note â¹pâPâº
moreover from calculation
obtain Ï q where "Ïâdomain(Ï)âªdomain(θ)" "qâP" "qâ¼p"
"(q forcesâ©a (Ï â Ï) ⧠¬ q forcesâ©a (Ï â θ)) â¨
(¬ q forcesâ©a (Ï â Ï) â§ q forcesâ©a (Ï â θ))"
using def_forces_eq by blast
moreover from this
obtain r where "râ¼q" "râP"
"(r forcesâ©a (Ï â Ï) â§ r forcesâ©a (Ï â θ)) â¨
(r forcesâ©a (Ï â Ï) â§ r forcesâ©a (Ï â θ))"
using not_forces_nmem strengthening_mem by blast
ultimately
show ?thesis using leq_transD by blast
qed
then
show "âdâ?D1 ⪠?D2 ⪠?D3. d â¼ p" by blast
qed
moreover
have "?D â P"
by auto
moreover
note â¹M_generic(G)âº
ultimately
obtain p where "pâG" "pâ?D"
unfolding M_generic_def by blast
then
consider
(1) "p forcesâ©a (Ï = θ)" |
(2) "âÏâdomain(Ï) ⪠domain(θ). p forcesâ©a (Ï â Ï) â§ p forcesâ©a (Ï â θ)" |
(3) "âÏâdomain(Ï) ⪠domain(θ). p forcesâ©a (Ï â Ï) â§ p forcesâ©a (Ï â θ)"
by blast
then
show ?thesis
proof (cases)
case 1
with â¹pâGâº
show ?thesis by blast
next
case 2
then
obtain Ï where "Ïâdomain(Ï) ⪠domain(θ)" "p forcesâ©a (Ï â Ï)" "p forcesâ©a (Ï â θ)"
by blast
moreover from this and â¹pâG⺠and assms
have "val(P,G,Ï)âval(P,G,Ï)"
using IV240a[of G Ï Ï] transitivity[OF _ domain_closed[simplified]] by blast
moreover note IH â¹val(P,G,Ï) = _âº
ultimately
obtain q where "qâG" "q forcesâ©a (Ï â θ)" by auto
moreover from this and â¹pâG⺠â¹M_generic(G)âº
obtain r where "râP" "râ¼p" "râ¼q"
by blast
moreover
note â¹M_generic(G)âº
ultimately
have "r forcesâ©a (Ï â θ)"
using strengthening_mem by blast
with â¹râ¼p⺠â¹p forcesâ©a (Ï â θ)⺠â¹râPâº
have "False"
unfolding forces_nmem_def by blast
then
show ?thesis by simp
next
case 3
then
obtain Ï where "Ïâdomain(Ï) ⪠domain(θ)" "p forcesâ©a (Ï â θ)" "p forcesâ©a (Ï â Ï)"
by blast
moreover from this and â¹pâG⺠and assms
have "val(P,G,Ï)âval(P,G,θ)"
using IV240a[of G Ï Î¸] transitivity[OF _ domain_closed[simplified]] by blast
moreover note IH â¹val(P,G,Ï) = _âº
ultimately
obtain q where "qâG" "q forcesâ©a (Ï â Ï)" by auto
moreover from this and â¹pâG⺠â¹M_generic(G)âº
obtain r where "râP" "râ¼p" "râ¼q"
by blast
moreover
note â¹M_generic(G)âº
ultimately
have "r forcesâ©a (Ï â Ï)"
using strengthening_mem by blast
with â¹râ¼p⺠â¹p forcesâ©a (Ï â Ï)⺠â¹râPâº
have "False"
unfolding forces_nmem_def by blast
then
show ?thesis by simp
qed
qed
lemma IV240b:
assumes
"M_generic(G)"
shows
"(ÏâMâ¶Î¸âMâ¶val(P,G,Ï) = val(P,G,θ) â¶ (âpâG. p forcesâ©a (Ï = θ))) â§
(ÏâMâ¶Î¸âMâ¶val(P,G,Ï) â val(P,G,θ) â¶ (âpâG. p forcesâ©a (Ï â θ)))"
(is "?Q(Ï,θ) â§ ?R(Ï,θ)")
proof (intro forces_induction)
fix Ï Î¸ p
assume "Ïâdomain(θ) â¹ ?Q(Ï, Ï)" for Ï
with assms
show "?R(Ï, θ)"
using IV240b_mem domain_closed transitivity by (simp)
next
fix Ï Î¸ p
assume "Ï â domain(Ï) ⪠domain(θ) â¹ ?R(Ï,Ï) â§ ?R(Ï,θ)" for Ï
moreover from this
have IH':"ÏâM ⹠θâM â¹ Ï â domain(Ï) ⪠domain(θ) â¹
(val(P,G, Ï) â val(P,G, Ï) â¶ (âqâG. q forcesâ©a (Ï â Ï))) â§
(val(P,G, Ï) â val(P,G, θ) â¶ (âqâG. q forcesâ©a (Ï â θ)))" for Ï
using domain_trans[OF trans_M]
by (blast)
ultimately
show "?Q(Ï,θ)"
using IV240b_eq[OF assms(1)] by (auto)
qed
lemma map_val_in_MG:
assumes
"envâlist(M)"
shows
"map(val(P,G),env)âlist(M[G])"
unfolding GenExt_def using assms map_type2 by simp
lemma truth_lemma_mem:
assumes
"envâlist(M)" "M_generic(G)"
"nânat" "mânat" "n<length(env)" "m<length(env)"
shows
"(âpâG. p â© Member(n,m) env) â· M[G], map(val(P,G),env) ⨠Member(n,m)"
using assms IV240a[OF assms(2), of "nth(n,env)" "nth(m,env)"]
IV240b[OF assms(2), of "nth(n,env)" "nth(m,env)"]
P_in_M leq_in_M one_in_M
Forces_Member[of _ "nth(n,env)" "nth(m,env)" env n m] map_val_in_MG
by (auto)
lemma truth_lemma_eq:
assumes
"envâlist(M)" "M_generic(G)"
"nânat" "mânat" "n<length(env)" "m<length(env)"
shows
"(âpâG. p â© Equal(n,m) env) â· M[G], map(val(P,G),env) ⨠Equal(n,m)"
using assms IV240a(1)[OF assms(2), of "nth(n,env)" "nth(m,env)"]
IV240b(1)[OF assms(2), of "nth(n,env)" "nth(m,env)"]
P_in_M leq_in_M one_in_M
Forces_Equal[of _ "nth(n,env)" "nth(m,env)" env n m] map_val_in_MG
by (auto)
lemma arities_at_aux:
assumes
"n â nat" "m â nat" "env â list(M)" "succ(n) ⪠succ(m) ⤠length(env)"
shows
"n < length(env)" "m < length(env)"
using assms succ_leE[OF Un_leD1, of n "succ(m)" "length(env)"]
succ_leE[OF Un_leD2, of "succ(n)" m "length(env)"] by auto
subsectionâ¹The Strenghtening Lemmaâº
lemma strengthening_lemma:
assumes
"pâP" "Ïâformula" "râP" "râ¼p"
"envâlist(M)" "arity(Ï)â¤length(env)"
shows
"p â© Ï env â¹ r â© Ï env"
using assms(2-)
proof (induct arbitrary:env)
case (Member n m)
then
have "n<length(env)" "m<length(env)"
using arities_at_aux by simp_all
moreover
assume "envâlist(M)"
moreover
note assms Member
ultimately
show ?case
using Forces_Member[of _ "nth(n,env)" "nth(m,env)" env n m]
strengthening_mem[of p r "nth(n,env)" "nth(m,env)"] by simp
next
case (Equal n m)
then
have "n<length(env)" "m<length(env)"
using arities_at_aux by simp_all
moreover
assume "envâlist(M)"
moreover
note assms Equal
ultimately
show ?case
using Forces_Equal[of _ "nth(n,env)" "nth(m,env)" env n m]
strengthening_eq[of p r "nth(n,env)" "nth(m,env)"] by simp
next
case (Nand Ï Ï)
with assms
show ?case
using Forces_Nand transitivity[OF _ P_in_M] pair_in_M_iff
transitivity[OF _ leq_in_M] leq_transD by auto
next
case (Forall Ï)
with assms
have "p â© Ï ([x] @ env)" if "xâM" for x
using that Forces_Forall by simp
with Forall
have "r â© Ï ([x] @ env)" if "xâM" for x
using that pred_le2 by (simp)
with assms Forall
show ?case
using Forces_Forall by simp
qed
subsectionâ¹The Density Lemmaâº
lemma arity_Nand_le:
assumes "Ï â formula" "Ï â formula" "arity(Nand(Ï, Ï)) ⤠length(env)" "envâlist(A)"
shows "arity(Ï) ⤠length(env)" "arity(Ï) ⤠length(env)"
using assms
by (rule_tac Un_leD1, rule_tac [5] Un_leD2, auto)
lemma dense_below_imp_forces:
assumes
"pâP" "Ïâformula"
"envâlist(M)" "arity(Ï)â¤length(env)"
shows
"dense_below({qâP. (q â© Ï env)},p) â¹ (p â© Ï env)"
using assms(2-)
proof (induct arbitrary:env)
case (Member n m)
then
have "n<length(env)" "m<length(env)"
using arities_at_aux by simp_all
moreover
assume "envâlist(M)"
moreover
note assms Member
ultimately
show ?case
using Forces_Member[of _ "nth(n,env)" "nth(m,env)" env n m]
density_mem[of p "nth(n,env)" "nth(m,env)"] by simp
next
case (Equal n m)
then
have "n<length(env)" "m<length(env)"
using arities_at_aux by simp_all
moreover
assume "envâlist(M)"
moreover
note assms Equal
ultimately
show ?case
using Forces_Equal[of _ "nth(n,env)" "nth(m,env)" env n m]
density_eq[of p "nth(n,env)" "nth(m,env)"] by simp
next
case (Nand Ï Ï)
{
fix q
assume "qâM" "qâP" "qâ¼ p" "q â© Ï env"
moreover
note Nand
moreover from calculation
obtain d where "dâP" "d â© Nand(Ï, Ï) env" "dâ¼ q"
using dense_belowI by auto
moreover from calculation
have "¬(dâ© Ï env)" if "d â© Ï env"
using that Forces_Nand refl_leq transitivity[OF _ P_in_M, of d] by auto
moreover
note arity_Nand_le[of Ï Ï]
moreover from calculation
have "d â© Ï env"
using strengthening_lemma[of q Ï d env] Un_leD1 by auto
ultimately
have "¬ (q â© Ï env)"
using strengthening_lemma[of q Ï d env] by auto
}
with â¹pâPâº
show ?case
using Forces_Nand[symmetric, OF _ Nand(6,1,3)] by blast
next
case (Forall Ï)
have "dense_below({qâP. q â© Ï ([a]@env)},p)" if "aâM" for a
proof
fix r
assume "râP" "râ¼p"
with â¹dense_below(_,p)âº
obtain q where "qâP" "qâ¼r" "q â© Forall(Ï) env"
by blast
moreover
note Forall â¹aâMâº
moreover from calculation
have "q â© Ï ([a]@env)"
using Forces_Forall by simp
ultimately
show "âd â {qâP. q â© Ï ([a]@env)}. d â P â§ dâ¼r"
by auto
qed
moreover
note Forall(2)[of "Cons(_,env)"] Forall(1,3-5)
ultimately
have "p â© Ï ([a]@env)" if "aâM" for a
using that pred_le2 by simp
with assms Forall
show ?case using Forces_Forall by simp
qed
lemma density_lemma:
assumes
"pâP" "Ïâformula" "envâlist(M)" "arity(Ï)â¤length(env)"
shows
"p â© Ï env â· dense_below({qâP. (q â© Ï env)},p)"
proof
assume "dense_below({qâP. (q â© Ï env)},p)"
with assms
show "(p â© Ï env)"
using dense_below_imp_forces by simp
next
assume "p â© Ï env"
with assms
show "dense_below({qâP. q â© Ï env},p)"
using strengthening_lemma refl_leq by auto
qed
subsectionâ¹The Truth Lemmaâº
lemma Forces_And:
assumes
"pâP" "env â list(M)" "Ïâformula" "Ïâformula"
"arity(Ï) ⤠length(env)" "arity(Ï) ⤠length(env)"
shows
"p â© And(Ï,Ï) env â· (p â© Ï env) â§ (p â© Ï env)"
proof
assume "p â© And(Ï, Ï) env"
with assms
have "dense_below({r â P . (r â© Ï env) â§ (r â© Ï env)}, p)"
using Forces_And_iff_dense_below by simp
then
have "dense_below({r â P . (r â© Ï env)}, p)" "dense_below({r â P . (r â© Ï env)}, p)"
by blast+
with assms
show "(p â© Ï env) â§ (p â© Ï env)"
using density_lemma[symmetric] by simp
next
assume "(p â© Ï env) â§ (p â© Ï env)"
have "dense_below({r â P . (r â© Ï env) â§ (r â© Ï env)}, p)"
proof (intro dense_belowI bexI conjI, assumption)
fix q
assume "qâP" "qâ¼ p"
with assms â¹(p â© Ï env) â§ (p â© Ï env)âº
show "qâ{r â P . (r â© Ï env) â§ (r â© Ï env)}" "qâ¼ q"
using strengthening_lemma refl_leq by auto
qed
with assms
show "p â© And(Ï,Ï) env"
using Forces_And_iff_dense_below by simp
qed
lemma Forces_Nand_alt:
assumes
"pâP" "env â list(M)" "Ïâformula" "Ïâformula"
"arity(Ï) ⤠length(env)" "arity(Ï) ⤠length(env)"
shows
"(p â© Nand(Ï,Ï) env) â· (p â© Neg(And(Ï,Ï)) env)"
using assms Forces_Nand Forces_And Forces_Neg by auto
lemma truth_lemma_Neg:
assumes
"Ïâformula" "M_generic(G)" "envâlist(M)" "arity(Ï)â¤length(env)" and
IH: "(âpâG. p â© Ï env) â· M[G], map(val(P,G),env) ⨠Ï"
shows
"(âpâG. p â© Neg(Ï) env) â· M[G], map(val(P,G),env) ⨠Neg(Ï)"
proof (intro iffI, elim bexE, rule ccontr)
fix p
assume "pâG" "p â© Neg(Ï) env" "¬(M[G],map(val(P,G),env) ⨠Neg(Ï))"
moreover
note assms
moreover from calculation
have "M[G], map(val(P,G),env) ⨠Ï"
using map_val_in_MG by simp
with IH
obtain r where "r â© Ï env" "râG" by blast
moreover from this and â¹M_generic(G)⺠â¹pâGâº
obtain q where "qâ¼p" "qâ¼r" "qâG"
by blast
moreover from calculation
have "q â© Ï env"
using strengthening_lemma[where Ï=Ï] by blast
ultimately
show "False"
using Forces_Neg[where Ï=Ï] transitivity[OF _ P_in_M] by blast
next
assume "M[G], map(val(P,G),env) ⨠Neg(Ï)"
with assms
have "¬ (M[G], map(val(P,G),env) ⨠Ï)"
using map_val_in_MG by simp
let ?D="{pâP. (p â© Ï env) ⨠(p â© Neg(Ï) env)}"
have "separation(##M,λp. (p â© Ï env))"
using separation_ax[of "forces(Ï)"] arity_forces assms P_in_M leq_in_M one_in_M arity_forces_le
by simp
moreover
have "separation(##M,λp. (p â© â
¬Ïâ
env))"
using separation_ax[of "forces( â
¬Ïâ
)"] arity_forces assms P_in_M leq_in_M one_in_M arity_forces_le
by simp
ultimately
have "separation(##M,λp. (p â© Ï env) ⨠(p â© Neg(Ï) env))"
using separation_disj by simp
then
have "?D â M"
using separation_closed P_in_M by simp
moreover
have "?D â P" by auto
moreover
have "dense(?D)"
proof
fix q
assume "qâP"
show "âdâ{p â P . (p â© Ï env) ⨠(p â© Neg(Ï) env)}. dâ¼ q"
proof (cases "q â© Neg(Ï) env")
case True
with â¹qâPâº
show ?thesis using refl_leq by blast
next
case False
with â¹qâP⺠and assms
show ?thesis using Forces_Neg by auto
qed
qed
moreover
note â¹M_generic(G)âº
ultimately
obtain p where "pâG" "(p â© Ï env) ⨠(p â© Neg(Ï) env)"
by blast
then
consider (1) "p â© Ï env" | (2) "p â© Neg(Ï) env" by blast
then
show "âpâG. (p â© Neg(Ï) env)"
proof (cases)
case 1
with â¹Â¬ (M[G],map(val(P,G),env) ⨠Ï)⺠â¹pâG⺠IH
show ?thesis
by blast
next
case 2
with â¹pâGâº
show ?thesis by blast
qed
qed
lemma truth_lemma_And:
assumes
"envâlist(M)" "Ïâformula" "Ïâformula"
"arity(Ï)â¤length(env)" "arity(Ï) ⤠length(env)" "M_generic(G)"
and
IH: "(âpâG. p â© Ï env) â· M[G], map(val(P,G),env) ⨠Ï"
"(âpâG. p â© Ï env) â· M[G], map(val(P,G),env) ⨠Ï"
shows
"(âpâG. (p â© And(Ï,Ï) env)) â· M[G] , map(val(P,G),env) ⨠And(Ï,Ï)"
using assms map_val_in_MG Forces_And[OF M_genericD assms(1-5)]
proof (intro iffI, elim bexE)
fix p
assume "pâG" "p â© And(Ï,Ï) env"
with assms
show "M[G], map(val(P,G),env) ⨠And(Ï,Ï)"
using Forces_And[OF M_genericD, of _ _ _ Ï Ï] map_val_in_MG by auto
next
assume "M[G], map(val(P,G),env) ⨠And(Ï,Ï)"
moreover
note assms
moreover from calculation
obtain q r where "q â© Ï env" "r â© Ï env" "qâG" "râG"
using map_val_in_MG Forces_And[OF M_genericD assms(1-5)] by auto
moreover from calculation
obtain p where "pâ¼q" "pâ¼r" "pâG"
by blast
moreover from calculation
have "(p â© Ï env) â§ (p â© Ï env)"
using strengthening_lemma by (blast)
ultimately
show "âpâG. (p â© And(Ï,Ï) env)"
using Forces_And[OF M_genericD assms(1-5)] by auto
qed
definition
ren_truth_lemma :: "iâi" where
"ren_truth_lemma(Ï) â¡
Exists(Exists(Exists(Exists(Exists(
And(Equal(0,5),And(Equal(1,8),And(Equal(2,9),And(Equal(3,10),And(Equal(4,6),
iterates(λp. incr_bv(p)`5 , 6, Ï)))))))))))"
lemma ren_truth_lemma_type[TC] :
"Ïâformula â¹ ren_truth_lemma(Ï) âformula"
unfolding ren_truth_lemma_def
by simp
lemma arity_ren_truth :
assumes "Ïâformula"
shows "arity(ren_truth_lemma(Ï)) ⤠6 ⪠succ(arity(Ï))"
proof -
consider (lt) "5 <arity(Ï)" | (ge) "¬ 5 < arity(Ï)"
by auto
then
show ?thesis
proof cases
case lt
consider (a) "5<arity(Ï)+â©Ï5" | (b) "arity(Ï)+â©Ï5 ⤠5"
using not_lt_iff_le â¹Ïâ_⺠by force
then
show ?thesis
proof cases
case a
with â¹Ïâ_⺠lt
have "5 < succ(arity(Ï))" "5<arity(Ï)+â©Ï2" "5<arity(Ï)+â©Ï3" "5<arity(Ï)+â©Ï4"
using succ_ltI by auto
with â¹Ïâ_âº
have c:"arity(iterates(λp. incr_bv(p)`5,5,Ï)) = 5+â©Ïarity(Ï)" (is "arity(?Ï') = _")
using arity_incr_bv_lemma lt a
by simp
with â¹Ïâ_âº
have "arity(incr_bv(?Ï')`5) = 6+â©Ïarity(Ï)"
using arity_incr_bv_lemma[of ?Ï' 5] a by auto
with â¹Ïâ_âº
show ?thesis
unfolding ren_truth_lemma_def
using pred_Un_distrib union_abs1 Un_assoc[symmetric] a c union_abs2
by (simp add:arity)
next
case b
with â¹Ïâ_⺠lt
have "5 < succ(arity(Ï))" "5<arity(Ï)+â©Ï2" "5<arity(Ï)+â©Ï3" "5<arity(Ï)+â©Ï4" "5<arity(Ï)+â©Ï5"
using succ_ltI by auto
with â¹Ïâ_âº
have "arity(iterates(λp. incr_bv(p)`5,6,Ï)) = 6+â©Ïarity(Ï)" (is "arity(?Ï') = _")
using arity_incr_bv_lemma lt
by simp
with â¹Ïâ_âº
show ?thesis
unfolding ren_truth_lemma_def
using pred_Un_distrib union_abs1 Un_assoc[symmetric] union_abs2
by (simp add:arity)
qed
next
case ge
with â¹Ïâ_âº
have "arity(Ï) ⤠5" "pred^5(arity(Ï)) ⤠5"
using not_lt_iff_le le_trans[OF le_pred]
by auto
with â¹Ïâ_âº
have "arity(iterates(λp. incr_bv(p)`5,6,Ï)) = arity(Ï)" "arity(Ï)â¤6" "pred^5(arity(Ï)) ⤠6"
using arity_incr_bv_lemma ge le_trans[OF â¹arity(Ï)â¤5âº] le_trans[OF â¹pred^5(arity(Ï))â¤5âº]
by auto
with â¹arity(Ï) ⤠5⺠â¹Ïâ_⺠â¹pred^5(_) ⤠5âº
show ?thesis
unfolding ren_truth_lemma_def
using pred_Un_distrib union_abs1 Un_assoc[symmetric] union_abs2
by (simp add:arity)
qed
qed
lemma sats_ren_truth_lemma:
"[q,b,d,a1,a2,a3] @ env â list(M) â¹ Ï â formula â¹
(M, [q,b,d,a1,a2,a3] @ env ⨠ren_truth_lemma(Ï) ) â·
(M, [q,a1,a2,a3,b] @ env ⨠Ï)"
unfolding ren_truth_lemma_def
by (insert sats_incr_bv_iff [of _ _ M _ "[q,a1,a2,a3,b]"], simp)
lemma truth_lemma' :
assumes
"Ïâformula" "envâlist(M)" "arity(Ï) ⤠succ(length(env))"
shows
"separation(##M,λd. âbâM. âqâP. qâ¼d ⶠ¬(q â© Ï ([b]@env)))"
proof -
let ?rel_pred="λM x a1 a2 a3. âbâM. âqâM. qâa1 â§ is_leq(##M,a2,q,x) â¶
¬(M, [q,a1,a2,a3,b] @ env ⨠forces(Ï))"
let ?Ï="Exists(Forall(Implies(And(Member(0,3),is_leq_fm(4,0,2)),
Neg(ren_truth_lemma(forces(Ï))))))"
have "qâM" if "qâP" for q using that transitivity[OF _ P_in_M] by simp
then
have 1:"âqâM. qâP â§ R(q) â¶ Q(q) â¹ (âqâP. R(q) â¶ Q(q))" for R Q
by auto
then
have "â¦b â M; âqâM. q â P â§ q â¼ d ⶠ¬(q â© Ï ([b]@env))â§ â¹
âcâM. âqâP. q â¼ d ⶠ¬(q â© Ï ([c]@env))" for b d
by (rule bexI,simp_all)
then
have "?rel_pred(M,d,P,leq,ð) â· (âbâM. âqâP. qâ¼d ⶠ¬(q â© Ï ([b]@env)))" if "dâM" for d
using that leq_abs leq_in_M P_in_M one_in_M assms
by auto
moreover
have "?Ïâformula" using assms by simp
moreover
have "(M, [d,P,leq,ð]@env ⨠?Ï) â· ?rel_pred(M,d,P,leq,ð)" if "dâM" for d
using assms that P_in_M leq_in_M one_in_M sats_is_leq_fm sats_ren_truth_lemma zero_in_M
by simp
moreover
have "arity(?Ï) ⤠4+â©Ïlength(env)"
proof -
have eq:"arity(is_leq_fm(4, 0, 2)) = 5"
using arity_is_leq_fm succ_Un_distrib ord_simp_union
by simp
with â¹Ïâ_âº
have "arity(?Ï) = 3 ⪠(pred^2(arity(ren_truth_lemma(forces(Ï)))))"
using union_abs1 pred_Un_distrib by (simp add:arity)
moreover
have "... ⤠3 ⪠(pred(pred(6 ⪠succ(arity(forces(Ï))))))" (is "_ ⤠?r")
using â¹Ïâ_⺠Un_le_compat[OF le_refl[of 3]]
le_imp_subset arity_ren_truth[of "forces(Ï)"]
pred_mono
by auto
finally
have "arity(?Ï) ⤠?r" by simp
have i:"?r ⤠4 ⪠pred(arity(forces(Ï)))"
using pred_Un_distrib pred_succ_eq â¹Ïâ_⺠Un_assoc[symmetric] union_abs1 by simp
have h:"4 ⪠pred(arity(forces(Ï))) ⤠4 ⪠(4+â©Ïlength(env))"
using â¹envâ_⺠add_commute â¹Ïâ_âº
Un_le_compat[of 4 4,OF _ pred_mono[OF _ arity_forces_le[OF _ _ â¹arity(Ï)â¤_âº]] ]
â¹envâ_⺠by auto
with â¹Ïâ_⺠â¹envâ_âº
show ?thesis
using le_trans[OF â¹arity(?Ï) ⤠?r⺠le_trans[OF i h]] ord_simp_union by simp
qed
ultimately
show ?thesis using assms P_in_M leq_in_M one_in_M
separation_ax[of "?Ï" "[P,leq,ð]@env"]
separation_cong[of "##M" "λy. (M, [y,P,leq,ð]@env â¨?Ï)"]
by simp
qed
lemma truth_lemma:
assumes
"Ïâformula" "M_generic(G)"
"envâlist(M)" "arity(Ï)â¤length(env)"
shows
"(âpâG. p â© Ï env) â· M[G], map(val(P,G),env) ⨠Ï"
using assms
proof (induct arbitrary:env)
case (Member x y)
then
show ?case
using assms truth_lemma_mem[OF â¹envâlist(M)⺠assms(2) â¹xânat⺠â¹yânatâº]
arities_at_aux by simp
next
case (Equal x y)
then
show ?case
using assms truth_lemma_eq[OF â¹envâlist(M)⺠assms(2) â¹xânat⺠â¹yânatâº]
arities_at_aux by simp
next
case (Nand Ï Ï)
moreover
note â¹M_generic(G)âº
ultimately
show ?case
using truth_lemma_And truth_lemma_Neg[of "â
Ï â§ Ïâ
"] Forces_Nand_alt
M_genericD map_val_in_MG arity_Nand_le[of Ï Ï] FOL_arities by auto
next
case (Forall Ï)
with â¹M_generic(G)âº
show ?case
proof (intro iffI)
assume "âpâG. (p â© Forall(Ï) env)"
with â¹M_generic(G)âº
obtain p where "pâG" "pâM" "pâP" "p â© Forall(Ï) env"
using transitivity[OF _ P_in_M] by auto
with â¹envâlist(M)⺠â¹Ïâformulaâº
have "p â© Ï ([x]@env)" if "xâM" for x
using that Forces_Forall by simp
with â¹pâG⺠â¹Ïâformula⺠â¹envâ_⺠â¹arity(Forall(Ï)) ⤠length(env)âº
Forall(2)[of "Cons(_,env)"] â¹M_generic(G)âº
show "M[G], map(val(P,G),env) ⨠Forall(Ï)"
using pred_le2 map_val_in_MG
by (auto iff:GenExt_iff)
next
assume "M[G], map(val(P,G),env) ⨠Forall(Ï)"
let ?D1="{dâP. (d â© Forall(Ï) env)}"
let ?D2="{dâP. âbâM. âqâP. qâ¼d ⶠ¬(q â© Ï ([b]@env))}"
define D where "D ⡠?D1 ⪠?D2"
have arÏ:"arity(Ï)â¤succ(length(env))"
using assms â¹arity(Forall(Ï)) ⤠length(env)⺠â¹Ïâformula⺠â¹envâlist(M)⺠pred_le2
by simp
then
have "arity(Forall(Ï)) ⤠length(env)"
using pred_le â¹Ïâformula⺠â¹envâlist(M)⺠by simp
then
have "?D1âM" using Collect_forces arÏ â¹Ïâformula⺠â¹envâlist(M)⺠by simp
moreover from â¹envâlist(M)⺠â¹Ïâformulaâº
have "?D2âM"
using truth_lemma'[of Ï] separation_closed arÏ P_in_M
by simp
ultimately
have "DâM" unfolding D_def using Un_closed by simp
moreover
have "D â P" unfolding D_def by auto
moreover
have "dense(D)"
proof
fix p
assume "pâP"
show "âdâD. dâ¼ p"
proof (cases "p â© Forall(Ï) env")
case True
with â¹pâPâº
show ?thesis unfolding D_def using refl_leq by blast
next
case False
with Forall â¹pâPâº
obtain b where "bâM" "¬(p â© Ï ([b]@env))"
using Forces_Forall by blast
moreover from this â¹pâP⺠Forall
have "¬dense_below({qâP. q â© Ï ([b]@env)},p)"
using density_lemma pred_le2 by auto
moreover from this
obtain d where "dâ¼p" "âqâP. qâ¼d ⶠ¬(q â© Ï ([b] @ env))"
"dâP" by blast
ultimately
show ?thesis unfolding D_def by auto
qed
qed
moreover
note â¹M_generic(G)âº
ultimately
obtain d where "d â D" "d â G" by blast
then
consider (1) "dâ?D1" | (2) "dâ?D2" unfolding D_def by blast
then
show "âpâG. (p â© Forall(Ï) env)"
proof (cases)
case 1
with â¹dâGâº
show ?thesis by blast
next
case 2
then
obtain b where "bâM" "âqâP. qâ¼d â¶Â¬(q â© Ï ([b] @ env))"
by blast
moreover from this(1) and â¹M[G], _ ⨠Forall(Ï)⺠and
Forall(2)[of "Cons(b,env)"] Forall(1,3-5) â¹M_generic(G)âº
obtain p where "pâG" "pâP" "p â© Ï ([b] @ env)"
using pred_le2 using map_val_in_MG by (auto iff:GenExt_iff)
moreover
note â¹dâG⺠â¹M_generic(G)âº
ultimately
obtain q where "qâG" "qâP" "qâ¼d" "qâ¼p" by blast
moreover from this and â¹p â© Ï ([b] @ env)âº
Forall â¹bâM⺠â¹pâPâº
have "q â© Ï ([b] @ env)"
using pred_le2 strengthening_lemma by simp
moreover
note â¹âqâP. qâ¼d â¶Â¬(q â© Ï ([b] @ env))âº
ultimately
show ?thesis by simp
qed
qed
qed
subsectionâ¹The ``Definition of forcing''âº
lemma definition_of_forcing:
assumes
"pâP" "Ïâformula" "envâlist(M)" "arity(Ï)â¤length(env)"
shows
"(p â© Ï env) â·
(âG. M_generic(G) â§ pâG â¶ M[G], map(val(P,G),env) ⨠Ï)"
proof (intro iffI allI impI, elim conjE)
fix G
assume "(p â© Ï env)" "M_generic(G)" "p â G"
with assms
show "M[G], map(val(P,G),env) ⨠Ï"
using truth_lemma[of Ï] by blast
next
assume 1: "âG.(M_generic(G)â§ pâG)â¶ M[G] , map(val(P,G),env) ⨠Ï"
{
fix r
assume 2: "râP" "râ¼p"
then
obtain G where "râG" "M_generic(G)"
textâ¹Here we're using countability (via the existence of
generic filters) of \<^term>â¹M⺠as a shortcut.âº
using generic_filter_existence by auto
moreover from calculation 2 â¹pâPâº
have "pâG"
unfolding M_generic_def using filter_leqD by simp
moreover note 1
ultimately
have "M[G], map(val(P,G),env) ⨠Ï"
by simp
with assms â¹M_generic(G)âº
obtain s where "sâG" "(s â© Ï env)"
using truth_lemma[of Ï] by blast
moreover from this and â¹M_generic(G)⺠â¹râGâº
obtain q where "qâG" "qâ¼s" "qâ¼r"
by blast
moreover from calculation â¹sâG⺠â¹M_generic(G)âº
have "sâP" "qâP"
unfolding M_generic_def filter_def by auto
moreover
note assms
ultimately
have "âqâP. qâ¼r â§ (q â© Ï env)"
using strengthening_lemma by blast
}
then
have "dense_below({qâP. (q â© Ï env)},p)"
unfolding dense_below_def by blast
with assms
show "(p â© Ï env)"
using density_lemma by blast
qed
lemmas definability = forces_type
end
end body>
Theory Ordinals_In_MG
sectionâ¹Ordinals in generic extensionsâº
theory Ordinals_In_MG
imports
Forcing_Theorems
begin
context G_generic1
begin
lemma rank_val: "rank(val(P,G,x)) ⤠rank(x)" (is "?Q(x)")
proof (induct rule:ed_induction[of ?Q])
case (1 x)
have "val(P,G,x) = {val(P,G,u). uâ{tâdomain(x). âpâP . â¨t,pâ©âx â§ p â G }}"
using def_val[of G x] by auto
then
have "rank(val(P,G,x)) = (âuâ{tâdomain(x). âpâP . â¨t,pâ©âx â§ p â G }. succ(rank(val(P,G,u))))"
using rank[of "val(P,G,x)"] by simp
moreover
have "succ(rank(val(P,G, y))) ⤠rank(x)" if "ed(y, x)" for y
using 1[OF that] rank_ed[OF that] by (auto intro:lt_trans1)
moreover from this
have "(âuâ{tâdomain(x). âpâP . â¨t,pâ©âx â§ p â G }. succ(rank(val(P,G,u)))) ⤠rank(x)"
by (rule_tac UN_least_le) (auto)
ultimately
show ?case
by simp
qed
lemma Ord_MG_iff:
assumes "Ord(α)"
shows "α â M ⷠα â M[G]"
proof
show "α â M[G]" if "α â M"
using generic[THEN one_in_G, THEN M_subset_MG] that ..
next
assume "α â M[G]"
then
obtain x where "xâM" "val(P,G,x) = α"
using GenExtD by auto
then
have "rank(α) ⤠rank(x)"
using rank_val by blast
with assms
have "α ⤠rank(x)"
using rank_of_Ord by simp
then
have "α â succ(rank(x))"
using ltD by simp
with â¹xâMâº
show "α â M"
using cons_closed transitivity[of α "succ(rank(x))"] rank_closed
unfolding succ_def by simp
qed
end
end
Theory Separation_Rename
sectionâ¹Auxiliary renamings for Separationâº
theory Separation_Rename
imports
Interface
begin
lemmas apply_fun = apply_iff[THEN iffD1]
lemma nth_concat : "[p,t] â list(A) â¹ envâ list(A) â¹ nth(1 +â©Ï length(env),[p]@ env @ [t]) = t"
by(auto simp add:nth_append)
lemma nth_concat2 : "envâ list(A) â¹ nth(length(env),env @ [p,t]) = p"
by(auto simp add:nth_append)
lemma nth_concat3 : "envâ list(A) â¹ u = nth(succ(length(env)), env @ [pi, u])"
by(auto simp add:nth_append)
definition
sep_var :: "i â i" where
"sep_var(n) â¡ {â¨0,1â©,â¨1,3â©,â¨2,4â©,â¨3,5â©,â¨4,0â©,â¨5+â©Ïn,6â©,â¨6+â©Ïn,2â©}"
definition
sep_env :: "i â i" where
"sep_env(n) ⡠λ i â (5+â©Ïn)-5 . i+â©Ï2"
definition weak :: "[i, i] â i" where
"weak(n,m) â¡ {i+â©Ïm . i â n}"
lemma weakD :
assumes "n â nat" "kânat" "x â weak(n,k)"
shows "â i â n . x = i+â©Ïk"
using assms unfolding weak_def by blast
lemma weak_equal :
assumes "nânat" "mânat"
shows "weak(n,m) = (m+â©Ïn) - m"
proof -
have "weak(n,m)â(m+â©Ïn)-m"
proof(intro subsetI)
fix x
assume "xâweak(n,m)"
with assms
obtain i where
"iân" "x=i+â©Ïm"
using weakD by blast
then
have "mâ¤i+â©Ïm" "i<n"
using add_le_self2[of m i] â¹mânat⺠â¹nânat⺠ltI[OF â¹iânâº] by simp_all
then
have "¬i+â©Ïm<m"
using not_lt_iff_le in_n_in_nat[OF â¹nânat⺠â¹iânâº] â¹mânat⺠by simp
with â¹x=i+â©Ïmâº
have "xâm"
using ltI â¹mânat⺠by auto
moreover
from assms â¹x=i+â©Ïm⺠â¹i<nâº
have "x<m+â©Ïn"
using add_lt_mono1[OF â¹i<n⺠â¹nânatâº] by simp
ultimately
show "xâ(m+â©Ïn)-m"
using ltD DiffI by simp
qed
moreover
have "(m+â©Ïn)-mâweak(n,m)"
proof (intro subsetI)
fix x
assume "xâ(m+â©Ïn)-m"
then
have "xâm+â©Ïn" "xâm"
using DiffD1[of x "n+â©Ïm" m] DiffD2[of x "n+â©Ïm" m] by simp_all
then
have "x<m+â©Ïn" "xânat"
using ltI in_n_in_nat[OF add_type[of m n]] by simp_all
then
obtain i where
"m+â©Ïn = succ(x+â©Ïi)"
using less_iff_succ_add[OF â¹xânatâº,of "m+â©Ïn"] add_type by auto
then
have "x+â©Ïi<m+â©Ïn" using succ_le_iff by simp
with â¹xâmâº
have "¬x<m" using ltD by blast
with â¹mânat⺠â¹xânatâº
have "mâ¤x" using not_lt_iff_le by simp
with â¹x<m+â©Ïn⺠â¹nânatâº
have "x-â©Ïm<m+â©Ïn-â©Ïm"
using diff_mono[OF â¹xânat⺠_ â¹mânatâº] by simp
have "m+â©Ïn-â©Ïm = n" using diff_cancel2 â¹mânat⺠â¹nânat⺠by simp
with â¹x-â©Ïm<m+â©Ïn-â©Ïm⺠â¹xânatâº
have "x-â©Ïm â n" "x=x-â©Ïm+â©Ïm"
using ltD add_diff_inverse2[OF â¹mâ¤xâº] by simp_all
then
show "xâweak(n,m)"
unfolding weak_def by auto
qed
ultimately
show ?thesis by auto
qed
lemma weak_zero:
shows "weak(0,n) = 0"
unfolding weak_def by simp
lemma weakening_diff :
assumes "n â nat"
shows "weak(n,7) - weak(n,5) â {5+â©Ïn, 6+â©Ïn}"
unfolding weak_def using assms
proof(auto)
{
fix i
assume "iân" "succ(succ(natify(i)))â n" "âwân. succ(succ(natify(i))) â natify(w)"
then
have "i<n"
using ltI â¹nânat⺠by simp
from â¹nânat⺠â¹iân⺠â¹succ(succ(natify(i)))â nâº
have "iânat" "succ(succ(i))â n" using in_n_in_nat by simp_all
from â¹i<nâº
have "succ(i)â¤n" using succ_leI by simp
with â¹nânatâº
consider (a) "succ(i) = n" | (b) "succ(i) < n"
using leD by auto
then have "succ(i) = n"
proof cases
case a
then show ?thesis .
next
case b
then
have "succ(succ(i))â¤n" using succ_leI by simp
with â¹nânatâº
consider (a) "succ(succ(i)) = n" | (b) "succ(succ(i)) < n"
using leD by auto
then have "succ(i) = n"
proof cases
case a
with â¹succ(succ(i))â n⺠show ?thesis by blast
next
case b
then
have "succ(succ(i))ân" using ltD by simp
with â¹iânatâº
have "succ(succ(natify(i))) â natify(succ(succ(i)))"
using â¹âwân. succ(succ(natify(i))) â natify(w)⺠by auto
then
have "False" using â¹iânat⺠by auto
then show ?thesis by blast
qed
then show ?thesis .
qed
with â¹iânat⺠have "succ(natify(i)) = n" by simp
}
then
show "n â nat â¹
succ(succ(natify(y))) â n â¹
âxân. succ(succ(natify(y))) â natify(x) â¹
y â n â¹ succ(natify(y)) = n" for y
by blast
qed
lemma in_add_del :
assumes "xâj+â©Ïn" "nânat" "jânat"
shows "x < j ⨠x â weak(n,j)"
proof (cases "x<j")
case True
then show ?thesis ..
next
case False
have "xânat" "j+â©Ïnânat"
using in_n_in_nat[OF _ â¹xâj+â©Ïnâº] assms by simp_all
then
have "j ⤠x" "x < j+â©Ïn"
using not_lt_iff_le False â¹jânat⺠â¹nânat⺠ltI[OF â¹xâj+â©Ïnâº] by auto
then
have "x-â©Ïj < (j +â©Ï n) -â©Ï j" "x = j +â©Ï (x -â©Ïj)"
using diff_mono â¹xânat⺠â¹j+â©Ïnânat⺠â¹jânat⺠â¹nânatâº
add_diff_inverse[OF â¹jâ¤xâº] by simp_all
then
have "x-â©Ïj < n" "x = (x -â©Ïj ) +â©Ï j"
using diff_add_inverse â¹nânat⺠add_commute by simp_all
then
have "x-â©Ïj ân" using ltD by simp
then
have "x â weak(n,j)"
unfolding weak_def
using â¹x= (x-â©Ïj) +â©Ïj⺠RepFunI[OF â¹x-â©Ïjânâº] add_commute by force
then show ?thesis ..
qed
lemma sep_env_action:
assumes
"[t,p,u,P,leq,o,pi] â list(M)"
"env â list(M)"
shows "â i . i â weak(length(env),5) â¶
nth(sep_env(length(env))`i,[t,p,u,P,leq,o,pi]@env) = nth(i,[p,P,leq,o,t] @ env @ [pi,u])"
proof -
from assms
have A: "5+â©Ïlength(env)ânat" "[p, P, leq, o, t] âlist(M)"
by simp_all
let ?f="sep_env(length(env))"
have EQ: "weak(length(env),5) = 5+â©Ïlength(env) - 5"
using weak_equal length_type[OF â¹envâlist(M)âº] by simp
let ?tgt="[t,p,u,P,leq,o,pi]@env"
let ?src="[p,P,leq,o,t] @ env @ [pi,u]"
have "nth(?f`i,[t,p,u,P,leq,o,pi]@env) = nth(i,[p,P,leq,o,t] @ env @ [pi,u])"
if "i â (5+â©Ïlength(env)-5)" for i
proof -
from that
have 2: "i â 5+â©Ïlength(env)" "i â 5" "i â nat" "i-â©Ï5ânat" "i+â©Ï2ânat"
using in_n_in_nat[OF â¹5+â©Ïlength(env)ânatâº] by simp_all
then
have 3: "¬ i < 5" using ltD by force
then
have "5 ⤠i" "2 ⤠5"
using not_lt_iff_le â¹iânat⺠by simp_all
then have "2 ⤠i" using le_trans[OF â¹2â¤5âº] by simp
from A â¹i â 5+â©Ïlength(env)âº
have "i < 5+â©Ïlength(env)" using ltI by simp
with â¹iânat⺠â¹2â¤i⺠A
have C:"i+â©Ï2 < 7+â©Ïlength(env)" by simp
with that
have B: "?f`i = i+â©Ï2" unfolding sep_env_def by simp
from 3 assms(1) â¹iânatâº
have "¬ i+â©Ï2 < 7" using not_lt_iff_le add_le_mono by simp
from â¹i < 5+â©Ïlength(env)⺠3 â¹iânatâº
have "i-â©Ï5 < 5+â©Ïlength(env) -â©Ï 5"
using diff_mono[of i "5+â©Ïlength(env)" 5,OF _ _ _ â¹i < 5+â©Ïlength(env)âº]
not_lt_iff_le[THEN iffD1] by force
with assms(2)
have "i-â©Ï5 < length(env)" using diff_add_inverse length_type by simp
have "nth(i,?src) =nth(i-â©Ï5,env@[pi,u])"
using nth_append[OF A(2) â¹iânatâº] 3 by simp
also
have "... = nth(i-â©Ï5, env)"
using nth_append[OF â¹env âlist(M)⺠â¹i-â©Ï5ânatâº] â¹i-â©Ï5 < length(env)⺠by simp
also
have "... = nth(i+â©Ï2, ?tgt)"
using nth_append[OF assms(1) â¹i+â©Ï2ânatâº] â¹Â¬ i+â©Ï2 <7⺠by simp
ultimately
have "nth(i,?src) = nth(?f`i,?tgt)"
using B by simp
then show ?thesis using that by simp
qed
then show ?thesis using EQ by force
qed
lemma sep_env_type :
assumes "n â nat"
shows "sep_env(n) : (5+â©Ïn)-5 â (7+â©Ïn)-7"
proof -
let ?h="sep_env(n)"
from â¹nânatâº
have "(5+â©Ïn)+â©Ï2 = 7+â©Ïn" "7+â©Ïnânat" "5+â©Ïnânat" by simp_all
have
D: "sep_env(n)`x â (7+â©Ïn)-7" if "x â (5+â©Ïn)-5" for x
proof -
from â¹xâ5+â©Ïn-5âº
have "?h`x = x+â©Ï2" "x<5+â©Ïn" "xânat"
unfolding sep_env_def using ltI in_n_in_nat[OF â¹5+â©Ïnânatâº] by simp_all
then
have "x+â©Ï2 < 7+â©Ïn" by simp
then
have "x+â©Ï2 â 7+â©Ïn" using ltD by simp
from â¹xâ5+â©Ïn-5âº
have "xâ5" by simp
then have "¬x<5" using ltD by blast
then have "5â¤x" using not_lt_iff_le â¹xânat⺠by simp
then have "7â¤x+â©Ï2" using add_le_mono â¹xânat⺠by simp
then have "¬x+â©Ï2<7" using not_lt_iff_le â¹xânat⺠by simp
then have "x+â©Ï2 â 7" using ltI â¹xânat⺠by force
with â¹x+â©Ï2 â 7+â©Ïn⺠show ?thesis using â¹?h`x = x+â©Ï2⺠DiffI by simp
qed
then show ?thesis unfolding sep_env_def using lam_type by simp
qed
lemma sep_var_fin_type :
assumes "n â nat"
shows "sep_var(n) : 7+â©Ïn -||> 7+â©Ïn"
unfolding sep_var_def
using consI ltD emptyI by force
lemma sep_var_domain :
assumes "n â nat"
shows "domain(sep_var(n)) = 7+â©Ïn - weak(n,5)"
proof -
let ?A="weak(n,5)"
have A:"domain(sep_var(n)) â (7+â©Ïn)"
unfolding sep_var_def
by(auto simp add: le_natE)
have C: "x=5+â©Ïn ⨠x=6+â©Ïn ⨠x ⤠4" if "xâdomain(sep_var(n))" for x
using that unfolding sep_var_def by auto
have D : "x<n+â©Ï7" if "xâ7+â©Ïn" for x
using that â¹nânat⺠ltI by simp
have "¬ 5+â©Ïn < 5+â©Ïn" using â¹nânat⺠lt_irrefl[of _ False] by force
have "¬ 6+â©Ïn < 5+â©Ïn" using â¹nânat⺠by force
have R: "x < 5+â©Ïn" if "xâ?A" for x
proof -
from that
obtain i where
"i<n" "x=5+â©Ïi"
unfolding weak_def
using ltI â¹nânat⺠RepFun_iff by force
with â¹nânatâº
have "5+â©Ïi < 5+â©Ïn" using add_lt_mono2 by simp
with â¹x=5+â©Ïiâº
show "x < 5+â©Ïn" by simp
qed
then
have 1:"xâ?A" if "¬x <5+â©Ïn" for x using that by blast
have "5+â©Ïn â ?A" "6+â©Ïnâ?A"
proof -
show "5+â©Ïn â ?A" using 1 â¹Â¬5+â©Ïn<5+â©Ïn⺠by blast
with 1 show "6+â©Ïn â ?A" using â¹Â¬6+â©Ïn<5+â©Ïn⺠by blast
qed
then
have E:"xâ?A" if "xâdomain(sep_var(n))" for x
unfolding weak_def
using C that by force
then
have F: "domain(sep_var(n)) â 7+â©Ïn - ?A" using A by auto
from assms
have "x<7 ⨠xâweak(n,7)" if "xâ7+â©Ïn" for x
using in_add_del[OF â¹xâ7+â©Ïnâº] by simp
moreover
{
fix x
assume asm:"xâ7+â©Ïn" "xâ?A" "xâweak(n,7)"
then
have "xâdomain(sep_var(n))"
proof -
from â¹nânatâº
have "weak(n,7)-weak(n,5)â{n+â©Ï5,n+â©Ï6}"
using weakening_diff by simp
with â¹xâ?A⺠asm
have "xâ{n+â©Ï5,n+â©Ï6}" using subsetD DiffI by blast
then
show ?thesis unfolding sep_var_def by simp
qed
}
moreover
{
fix x
assume asm:"xâ7+â©Ïn" "xâ?A" "x<7"
then have "xâdomain(sep_var(n))"
proof (cases "2 ⤠n")
case True
moreover
have "0<n" using leD[OF â¹nânat⺠â¹2â¤nâº] lt_imp_0_lt by auto
ultimately
have "x<5"
using â¹x<7⺠â¹xâ?A⺠â¹nânat⺠in_n_in_nat
unfolding weak_def
by (clarsimp simp add:not_lt_iff_le, auto simp add:lt_def)
then
show ?thesis unfolding sep_var_def
by (clarsimp simp add:not_lt_iff_le, auto simp add:lt_def)
next
case False
then
show ?thesis
proof (cases "n=0")
case True
then show ?thesis
unfolding sep_var_def using ltD asm â¹nânat⺠by auto
next
case False
then
have "n < 2" using â¹nânat⺠not_lt_iff_le â¹Â¬ 2 ⤠n⺠by force
then
have "¬ n <1" using â¹nâ 0⺠by simp
then
have "n=1" using not_lt_iff_le â¹n<2⺠le_iff by auto
then show ?thesis
using â¹xâ?Aâº
unfolding weak_def sep_var_def
using ltD asm â¹nânat⺠by force
qed
qed
}
ultimately
have "wâdomain(sep_var(n))" if "wâ 7+â©Ïn - ?A" for w
using that by blast
then
have "7+â©Ïn - ?A â domain(sep_var(n))" by blast
with F
show ?thesis by auto
qed
lemma sep_var_type :
assumes "n â nat"
shows "sep_var(n) : (7+â©Ïn)-weak(n,5) â 7+â©Ïn"
using FiniteFun_is_fun[OF sep_var_fin_type[OF â¹nânatâº]]
sep_var_domain[OF â¹nânatâº] by simp
lemma sep_var_action :
assumes
"[t,p,u,P,leq,o,pi] â list(M)"
"env â list(M)"
shows "â i . i â (7+â©Ïlength(env)) - weak(length(env),5) â¶
nth(sep_var(length(env))`i,[t,p,u,P,leq,o,pi]@env) = nth(i,[p,P,leq,o,t] @ env @ [pi,u])"
using assms
proof (subst sep_var_domain[OF length_type[OF â¹envâlist(M)âº],symmetric],auto)
fix i y
assume "â¨i, yâ© â sep_var(length(env))"
with assms
show "nth(sep_var(length(env)) ` i,
Cons(t, Cons(p, Cons(u, Cons(P, Cons(leq, Cons(o, Cons(pi, env)))))))) =
nth(i, Cons(p, Cons(P, Cons(leq, Cons(o, Cons(t, env @ [pi, u]))))))"
using apply_fun[OF sep_var_type] assms
unfolding sep_var_def
using nth_concat2[OF â¹envâlist(M)âº] nth_concat3[OF â¹envâlist(M)âº,symmetric]
by force
qed
definition
rensep :: "i â i" where
"rensep(n) â¡ union_fun(sep_var(n),sep_env(n),7+â©Ïn-weak(n,5),weak(n,5))"
lemma rensep_aux :
assumes "nânat"
shows "(7+â©Ïn-weak(n,5)) ⪠weak(n,5) = 7+â©Ïn" "7+â©Ïn ⪠( 7 +â©Ï n - 7) = 7+â©Ïn"
proof -
from â¹nânatâº
have "weak(n,5) = n+â©Ï5-5"
using weak_equal by simp
with â¹nânatâº
show "(7+â©Ïn-weak(n,5)) ⪠weak(n,5) = 7+â©Ïn" "7+â©Ïn ⪠( 7 +â©Ï n - 7) = 7+â©Ïn"
using Diff_partition le_imp_subset by auto
qed
lemma rensep_type :
assumes "nânat"
shows "rensep(n) â 7+â©Ïn â 7+â©Ïn"
proof -
from â¹nânatâº
have "rensep(n) â (7+â©Ïn-weak(n,5)) ⪠weak(n,5) â 7+â©Ïn ⪠(7+â©Ïn - 7)"
unfolding rensep_def
using union_fun_type sep_var_type â¹nânat⺠sep_env_type weak_equal
by force
then
show ?thesis using rensep_aux â¹nânat⺠by auto
qed
lemma rensep_action :
assumes "[t,p,u,P,leq,o,pi] @ env â list(M)"
shows "â i . i < 7+â©Ïlength(env) â¶ nth(rensep(length(env))`i,[t,p,u,P,leq,o,pi]@env) = nth(i,[p,P,leq,o,t] @ env @ [pi,u])"
proof -
let ?tgt="[t,p,u,P,leq,o,pi]@env"
let ?src="[p,P,leq,o,t] @ env @ [pi,u]"
let ?m="7 +â©Ï length(env) - weak(length(env),5)"
let ?p="weak(length(env),5)"
let ?f="sep_var(length(env))"
let ?g="sep_env(length(env))"
let ?n="length(env)"
from assms
have 1 : "[t,p,u,P,leq,o,pi] â list(M)" " env â list(M)"
"?src â list(M)" "?tgt â list(M)"
"7+â©Ï?n = (7+â©Ï?n-weak(?n,5)) ⪠weak(?n,5)"
" length(?src) = (7+â©Ï?n-weak(?n,5)) ⪠weak(?n,5)"
using Diff_partition le_imp_subset rensep_aux by auto
then
have "nth(i, ?src) = nth(union_fun(?f, ?g, ?m, ?p) ` i, ?tgt)" if "i < 7+â©Ïlength(env)" for i
proof -
from â¹i<7+â©Ï?nâº
have "i â (7+â©Ï?n-weak(?n,5)) ⪠weak(?n,5)"
using ltD by simp
then show ?thesis
unfolding rensep_def using
union_fun_action[OF â¹?srcâlist(M)⺠â¹?tgtâlist(M)⺠â¹length(?src) = (7+â©Ï?n-weak(?n,5)) ⪠weak(?n,5)âº
sep_var_action[OF â¹[t,p,u,P,leq,o,pi] â list(M)⺠â¹envâlist(M)âº]
sep_env_action[OF â¹[t,p,u,P,leq,o,pi] â list(M)⺠â¹envâlist(M)âº]
] that
by simp
qed
then show ?thesis unfolding rensep_def by simp
qed
definition sep_ren :: "[i,i] â i" where
"sep_ren(n,Ï) â¡ ren(Ï)`(7+â©Ïn)`(7+â©Ïn)`rensep(n)"
lemma arity_rensep: assumes "Ïâformula" "env â list(M)"
"arity(Ï) ⤠7+â©Ïlength(env)"
shows "arity(sep_ren(length(env),Ï)) ⤠7+â©Ïlength(env)"
unfolding sep_ren_def
using arity_ren rensep_type assms
by simp
lemma type_rensep [TC]:
assumes "Ïâformula" "envâlist(M)"
shows "sep_ren(length(env),Ï) â formula"
unfolding sep_ren_def
using ren_tc rensep_type assms
by simp
lemma sepren_action:
assumes "arity(Ï) ⤠7 +â©Ï length(env)"
"[t,p,u,P,leq,o,pi] â list(M)"
"envâlist(M)"
"Ïâformula"
shows "sats(M, sep_ren(length(env),Ï),[t,p,u,P,leq,o,pi] @ env) â· sats(M, Ï,[p,P,leq,o,t] @ env @ [pi,u])"
proof -
from assms
have 1: "[t, p, u, P, leq, o, pi] @ env â list(M)"
by simp_all
then
have 2: "[p,P,leq,o,t] @ env @ [pi,u] â list(M)"
using app_type by simp
show ?thesis
unfolding sep_ren_def
using sats_iff_sats_ren[OF â¹Ïâformulaâº
add_type[of 7 "length(env)"]
add_type[of 7 "length(env)"]
2 1
rensep_type[OF length_type[OF â¹envâlist(M)âº]]
â¹arity(Ï) ⤠7 +â©Ï length(env)âº]
rensep_action[OF 1,rule_format,symmetric]
by simp
qed
end
Theory Separation_Axiom
sectionâ¹The Axiom of Separation in $M[G]$âº
theory Separation_Axiom
imports Forcing_Theorems Separation_Rename
begin
context G_generic1
begin
lemma map_val :
assumes "envâlist(M[G])"
shows "ânenvâlist(M). env = map(val(P,G),nenv)"
using assms
proof(induct env)
case Nil
have "map(val(P,G),Nil) = Nil" by simp
then show ?case by force
next
case (Cons a l)
then obtain a' l' where
"l' â list(M)" "l=map(val(P,G),l')" "a = val(P,G,a')"
"Cons(a,l) = map(val(P,G),Cons(a',l'))" "Cons(a',l') â list(M)"
using â¹aâM[G]⺠GenExtD
by force
then show ?case by force
qed
lemma Collect_sats_in_MG :
assumes
"câM[G]"
"Ï â formula" "envâlist(M[G])" "arity(Ï) ⤠1 +â©Ï length(env)"
shows
"{xâc. (M[G], [x] @ env ⨠Ï)}â M[G]"
proof -
from â¹câM[G]âº
obtain Ï where "Ï â M" "val(P,G, Ï) = c"
using GenExt_def by auto
let ?Ï="â
â
0 â (1 +â©Ï length(env)) â
â§ Ï â
" and ?Pl1="[P,leq,ð]"
let ?new_form="sep_ren(length(env),forces(?Ï))"
let ?Ï="Exists(Exists(And(pair_fm(0,1,2),?new_form)))"
note phi = â¹Ïâformula⺠â¹arity(Ï) ⤠1 +â©Ï length(env)âº
then
have "?Ïâformula" by simp
with â¹envâ_⺠phi
have "arity(?Ï) ⤠2+â©Ïlength(env) "
using ord_simp_union leI FOL_arities by simp
with â¹envâlist(_)⺠phi
have "arity(forces(?Ï)) ⤠6 +â©Ï length(env)"
using arity_forces_le by simp
then
have "arity(forces(?Ï)) ⤠7 +â©Ï length(env)"
using ord_simp_union arity_forces leI by simp
with â¹arity(forces(?Ï)) â¤7 +â©Ï _⺠â¹env â _⺠â¹Ï â formulaâº
have "arity(?new_form) ⤠7 +â©Ï length(env)" "?new_form â formula"
using arity_rensep[OF definability[of "?Ï"]] definability[of "?Ï"] type_rensep
by auto
then
have "pred(pred(arity(?new_form))) ⤠5 +â©Ï length(env)" "?Ïâformula"
unfolding pair_fm_def upair_fm_def
using ord_simp_union length_type[OF â¹envâlist(M[G])âº]
pred_mono[OF _ pred_mono[OF _ â¹arity(?new_form) ⤠_âº]]
by auto
with â¹arity(?new_form) ⤠_⺠â¹?new_form â formulaâº
have "arity(?Ï) ⤠5 +â©Ï length(env)"
unfolding pair_fm_def upair_fm_def
using ord_simp_union arity_forces
by (auto simp:arity)
from â¹Ïâformulaâº
have "forces(?Ï) â formula"
using definability by simp
from â¹ÏâM⺠P_in_M
have "domain(Ï)âM" "domain(Ï) Ã P â M"
by (simp_all flip:setclass_iff)
from â¹env â _âº
obtain nenv where "nenvâlist(M)" "env = map(val(P,G),nenv)" "length(nenv) = length(env)"
using map_val by auto
from â¹arity(Ï) ⤠_⺠â¹envâ_⺠â¹Ïâ_âº
have "arity(Ï) ⤠2+â©Ï length(env)"
using le_trans[OF â¹arity(Ï)â¤_âº] add_le_mono[of 1 2,OF _ le_refl]
by auto
with â¹nenvâ_⺠â¹envâ_⺠â¹ÏâM⺠â¹Ïâ_⺠â¹length(nenv) = length(env)âº
have "arity(?Ï) ⤠length([θ] @ nenv @ [Ï])" for θ
using union_abs2[OF â¹arity(Ï) ⤠2+â©Ï _âº] ord_simp_union FOL_arities
by simp
note in_M = â¹ÏâM⺠â¹domain(Ï) à P â M⺠P_in_M one_in_M leq_in_M
{
fix u
assume "u â domain(Ï) Ã P" "u â M"
with in_M â¹?new_form â formula⺠â¹?Ïâformula⺠â¹nenv â _âº
have Eq1: "(M, [u] @ ?Pl1 @ [Ï] @ nenv ⨠?Ï) â·
(âθâM. âpâP. u =â¨Î¸,pâ© â§
(M, [θ,p,u]@?Pl1@[Ï] @ nenv ⨠?new_form))"
by (auto simp add: transitivity)
have Eq3: "θâM â¹ pâP â¹
(M, [θ,p,u]@?Pl1@[Ï]@nenv ⨠?new_form) â·
(âF. M_generic(F) â§ p â F â¶ (M[F], map(val(P,F), [θ] @ nenv@[Ï]) ⨠?Ï))"
for θ p
proof -
fix p θ
assume "θ â M" "pâP"
then
have "pâM" using P_in_M by (simp add: transitivity)
note in_M' = in_M â¹Î¸ â M⺠â¹pâM⺠â¹u â domain(Ï) à P⺠â¹u â M⺠â¹nenvâ_âº
then
have "[θ,u] â list(M)" by simp
let ?env="[p]@?Pl1@[θ] @ nenv @ [Ï,u]"
let ?new_env=" [θ,p,u,P,leq,ð,Ï] @ nenv"
let ?Ï="Exists(Exists(And(pair_fm(0,1,2),?new_form)))"
have "[θ, p, u, Ï, leq, ð, Ï] â list(M)"
using in_M' by simp
have "?Ï â formula" "forces(?Ï)â formula"
using phi by simp_all
from in_M'
have "?Pl1 â list(M)" by simp
from in_M' have "?env â list(M)" by simp
have Eq1': "?new_env â list(M)" using in_M' by simp
then
have "(M, [θ,p,u]@?Pl1@[Ï] @ nenv ⨠?new_form) â· (M, ?new_env ⨠?new_form)"
by simp
from in_M' â¹env â _⺠Eq1' â¹length(nenv) = length(env)âº
â¹arity(forces(?Ï)) ⤠7 +â©Ï length(env)⺠â¹forces(?Ï)â formulaâº
â¹[θ, p, u, Ï, leq, ð, Ï] â list(M)âº
have "... â· M, ?env ⨠forces(?Ï)"
using sepren_action[of "forces(?Ï)" "nenv",OF _ _ â¹nenvâlist(M)âº]
by simp
also from in_M'
have "... â· M, ([p,P, leq, ð,θ]@nenv@ [Ï])@[u] ⨠forces(?Ï)"
using app_assoc by simp
also
from in_M' â¹envâ_⺠phi â¹length(nenv) = length(env)âº
â¹arity(forces(?Ï)) ⤠6 +â©Ï length(env)⺠â¹forces(?Ï)âformulaâº
have "... â· M, [p,P, leq, ð,θ]@ nenv @ [Ï] ⨠forces(?Ï)"
by (rule_tac arity_sats_iff,auto)
also
from â¹arity(forces(?Ï)) ⤠6 +â©Ï length(env)⺠â¹forces(?Ï)âformula⺠in_M' phi
have " ... â· (âF. M_generic(F) â§ p â F â¶
M[F], map(val(P,F), [θ] @ nenv @ [Ï]) ⨠?Ï)"
proof (intro iffI)
assume a1: "M, [p,P, leq, ð,θ] @ nenv @ [Ï] ⨠forces(?Ï)"
note â¹arity(Ï)⤠1+â©Ï_âº
with â¹nenvâ_⺠â¹arity(?Ï) ⤠length([θ] @ nenv @ [Ï])⺠â¹envâ_âº
have "p â P â¹ ?Ïâformula â¹ [θ,Ï] â list(M) â¹
M, [p,P, leq, ð] @ [θ]@ nenv@[Ï] ⨠forces(?Ï) â¹
âG. M_generic(G) â§ p â G â¶ M[G], map(val(P,G), [θ] @ nenv @[Ï]) ⨠?Ï"
using definition_of_forcing[where Ï="â
â
0 â (1 +â©Ï length(env)) â
â§ Ï â
"]
by auto
then
show "âF. M_generic(F) â§ p â F â¶
M[F], map(val(P,F), [θ] @ nenv @ [Ï]) ⨠?Ï"
using â¹?Ïâformula⺠â¹pâP⺠a1 â¹Î¸âM⺠â¹ÏâM⺠by simp
next
assume "âF. M_generic(F) â§ p â F â¶
M[F], map(val(P,F), [θ] @ nenv @[Ï]) ⨠?Ï"
with â¹?Ïâformula⺠â¹pâP⺠in_M'
â¹arity(?Ï) ⤠length([θ] @ nenv @ [Ï])âº
show "M, [p, P, leq, ð,θ] @ nenv @ [Ï] ⨠forces(?Ï)"
using definition_of_forcing[where Ï="â
â
0 â (1 +â©Ï length(env)) â
â§ Ï â
",
THEN iffD2] by auto
qed
finally
show "(M, [θ,p,u]@?Pl1@[Ï]@nenv ⨠?new_form) â· (âF. M_generic(F) â§ p â F â¶
M[F], map(val(P,F), [θ] @ nenv @ [Ï]) ⨠?Ï)"
by simp
qed
with Eq1
have "(M, [u] @ ?Pl1 @ [Ï] @ nenv ⨠?Ï) â·
(âθâM. âpâP. u =â¨Î¸,pâ© â§
(âF. M_generic(F) â§ p â F â¶ M[F], map(val(P,F), [θ] @ nenv @ [Ï]) ⨠?Ï))"
by auto
}
then
have Equivalence: "uâ domain(Ï) Ã P â¹ u â M â¹
(M, [u] @ ?Pl1 @ [Ï] @ nenv ⨠?Ï) â·
(âθâM. âpâP. u =â¨Î¸,pâ© â§
(âF. M_generic(F) â§ p â F â¶ M[F], map(val(P,F), [θ] @ nenv @[Ï]) ⨠?Ï))"
for u
by simp
moreover from â¹env = _⺠â¹ÏâM⺠â¹nenvâlist(M)âº
have map_nenv:"map(val(P,G), nenv@[Ï]) = env @ [val(P,G,Ï)]"
using map_app_distrib append1_eq_iff by auto
ultimately
have aux:"(âθâM. âpâP. u =â¨Î¸,pâ© â§ (pâG â¶ M[G], [val(P,G,θ)] @ env @ [val(P,G,Ï)] ⨠?Ï))"
(is "(âθâM. âpâP. _ ( _ â¶ _, ?vals(θ) ⨠_))")
if "u â domain(Ï) à P" "u â M" "M, [u]@ ?Pl1 @[Ï] @ nenv ⨠?Ï" for u
using Equivalence[THEN iffD1, OF that] generic by force
moreover
have "θâM â¹ val(P,G,θ)âM[G]" for θ
using GenExt_def by auto
moreover
have "θâ M â¹ [val(P,G, θ)] @ env @ [val(P,G, Ï)] â list(M[G])" for θ
proof -
from â¹ÏâMâº
have "val(P,G,Ï)â M[G]" using GenExtI by simp
moreover
assume "θ â M"
moreover
note â¹env â list(M[G])âº
ultimately
show ?thesis
using GenExtI by simp
qed
ultimately
have "(âθâM. âpâP. u=â¨Î¸,pâ© â§ (pâG â¶ val(P,G,θ)ânth(1 +â©Ï length(env),[val(P,G, θ)] @ env @ [val(P,G, Ï)])
â§ (M[G], ?vals(θ) ⨠Ï)))"
if "u â domain(Ï) à P" "u â M" "M, [u] @ ?Pl1 @[Ï] @ nenv ⨠?Ï" for u
using aux[OF that] by simp
moreover from â¹env â _⺠â¹ÏâMâº
have nth:"nth(1 +â©Ï length(env),[val(P,G, θ)] @ env @ [val(P,G, Ï)]) = val(P,G,Ï)"
if "θâM" for θ
using nth_concat[of "val(P,G,θ)" "val(P,G,Ï)" "M[G]"] using that GenExtI by simp
ultimately
have "(âθâM. âpâP. u=â¨Î¸,pâ© â§ (pâG â¶ val(P,G,θ)âval(P,G,Ï) â§ (M[G],?vals(θ) ⨠Ï)))"
if "u â domain(Ï) à P" "u â M" "M, [u] @ ?Pl1 @[Ï] @ nenv ⨠?Ï" for u
using that â¹ÏâM⺠â¹env â _⺠by simp
with â¹domain(Ï)ÃPâMâº
have "âuâdomain(Ï)ÃP . (M, [u] @ ?Pl1 @[Ï] @ nenv ⨠?Ï) â¶ (âθâM. âpâP. u =â¨Î¸,pâ© â§
(p â G â¶ val(P,G, θ)âval(P,G, Ï) â§ (M[G],?vals(θ) ⨠Ï)))"
by (simp add:transitivity)
then
have "{uâdomain(Ï)ÃP . (M,[u] @ ?Pl1 @[Ï] @ nenv ⨠?Ï) } â
{uâdomain(Ï)ÃP . âθâM. âpâP. u =â¨Î¸,pâ© â§
(p â G â¶ val(P,G, θ)âval(P,G, Ï) â§ (M[G], ?vals(θ) ⨠Ï))}"
(is "?nâ?m")
by auto
with val_mono
have first_incl: "val(P,G,?n) â val(P,G,?m)"
by simp
note â¹val(P,G,Ï) = câº
with â¹?Ïâformula⺠â¹arity(?Ï) ⤠_⺠in_M â¹nenv â _⺠â¹env â _⺠â¹length(nenv) = _âº
have "?nâM"
using separation_ax leI separation_iff by auto
from generic
have "filter(G)" "GâP"
unfolding M_generic_def filter_def by simp_all
from â¹val(P,G,Ï) = câº
have "val(P,G,?m) =
{z . tâdomain(Ï) , (âqâP .
(âθâM. âpâP. â¨t,qâ© = â¨Î¸, pâ© â§
(p â G â¶ val(P,G, θ) â c â§ (M[G], [val(P,G, θ)] @ env @ [c] ⨠Ï)) â§ q â G)) â§
z=val(P,G,t)}"
using val_of_name by auto
also
have "... = {z . tâdomain(Ï) , (âqâP.
val(P,G, t) â c â§ (M[G], [val(P,G, t)] @ env @ [c] ⨠Ï) â§ q â G) â§ z=val(P,G,t)}"
proof -
have "tâM â¹
(âqâP. (âθâM. âpâP. â¨t,qâ© = â¨Î¸, pâ© â§
(p â G â¶ val(P,G, θ) â c â§ (M[G], [val(P,G, θ)] @ env @ [c] ⨠Ï)) â§ q â G))
â·
(âqâP. val(P,G, t) â c â§ ( M[G], [val(P,G, t)]@env@[c]â¨ Ï ) â§ q â G)" for t
by auto
then show ?thesis using â¹domain(Ï)âM⺠by (auto simp add:transitivity)
qed
also
have "... = {xâc . âqâP. x â c â§ (M[G], [x] @ env @ [c] ⨠Ï) â§ q â G}"
proof
show "... â {xâc . âqâP. x â c â§ (M[G], [x] @ env @ [c] ⨠Ï) â§ q â G}"
by auto
next
{
fix x
assume "xâ{xâc . âqâP. x â c â§ (M[G], [x] @ env @ [c] ⨠Ï) â§ q â G}"
then
have "âqâP. x â c â§ (M[G], [x] @ env @ [c] ⨠Ï) â§ q â G"
by simp
with â¹val(P,G,Ï) = câº
have "âqâP. âtâdomain(Ï). val(P,G,t) =x â§ (M[G], [val(P,G,t)] @ env @ [c] ⨠Ï) â§ q â G"
using elem_of_val by auto
}
then
show " {xâc . âqâP. x â c â§ (M[G], [x] @ env @ [c] ⨠Ï) â§ q â G} â ..."
by force
qed
also
have " ... = {xâc. (M[G], [x] @ env @ [c] ⨠Ï)}"
using â¹GâP⺠G_nonempty by force
finally
have val_m: "val(P,G,?m) = {xâc. (M[G], [x] @ env @ [c] ⨠Ï)}" by simp
have "val(P,G,?m) â val(P,G,?n)"
proof
fix x
assume "x â val(P,G,?m)"
with val_m
have Eq4: "x â {xâc. (M[G], [x] @ env @ [c] ⨠Ï)}" by simp
with â¹val(P,G,Ï) = câº
have "x â val(P,G,Ï)" by simp
then
have "âθ. âqâG. â¨Î¸,qâ©âÏ â§ val(P,G,θ) =x"
using elem_of_val_pair by auto
then obtain θ q where
"â¨Î¸,qâ©âÏ" "qâG" "val(P,G,θ)=x" by auto
from â¹â¨Î¸,qâ©âÏâº
have "θâM"
using domain_trans[OF trans_M â¹Ïâ_âº] by auto
with â¹ÏâM⺠â¹nenv â _⺠â¹env = _âº
have "[val(P,G,θ), val(P,G,Ï)] @ env âlist(M[G])"
using GenExt_def by auto
with Eq4 â¹val(P,G,θ)=x⺠â¹val(P,G,Ï) = c⺠â¹x â val(P,G,Ï)⺠nth â¹Î¸âMâº
have Eq5: "M[G], [val(P,G,θ)] @ env @[val(P,G,Ï)] ⨠And(Member(0,1 +â©Ï length(env)),Ï)"
by auto
with â¹Î¸âM⺠â¹ÏâM⺠Eq5 â¹M_generic(G)⺠â¹Ïâformula⺠â¹nenv â _ ⺠â¹env = _ ⺠map_nenv
â¹arity(?Ï) ⤠length([θ] @ nenv @ [Ï])âº
have "(ârâG. M, [r,P,leq,ð,θ] @ nenv @[Ï] ⨠forces(?Ï))"
using truth_lemma[of "â
â
0 â (1 +â©Ï length(env)) â
â§ Ï â
"]
by auto
then obtain r where
"râG" "M, [r,P,leq,ð,θ] @ nenv @ [Ï] ⨠forces(?Ï)" by auto
with â¹filter(G)⺠and â¹qâG⺠obtain p where
"pâG" "pâ¼q" "pâ¼r"
unfolding filter_def compat_in_def by force
with â¹râG⺠â¹qâG⺠â¹GâPâº
have "pâP" "râP" "qâP" "pâM"
using P_in_M by (auto simp add:transitivity)
with â¹Ïâformula⺠â¹Î¸âM⺠â¹ÏâM⺠â¹pâ¼r⺠â¹nenv â _⺠â¹arity(?Ï) ⤠length([θ] @ nenv @ [Ï])âº
â¹M, [r,P,leq,ð,θ] @ nenv @ [Ï] ⨠forces(?Ï)⺠â¹envâ_âº
have "M, [p,P,leq,ð,θ] @ nenv @ [Ï] ⨠forces(?Ï)"
using strengthening_lemma
by simp
with â¹pâP⺠â¹Ïâformula⺠â¹Î¸âM⺠â¹ÏâM⺠â¹nenv â _⺠â¹arity(?Ï) ⤠length([θ] @ nenv @ [Ï])âº
have "âF. M_generic(F) â§ p â F â¶
M[F], map(val(P,F), [θ] @ nenv @[Ï]) ⨠?Ï"
using definition_of_forcing[where Ï="â
â
0 â (1 +â©Ï length(env)) â
â§ Ï â
"]
by simp
with â¹pâP⺠â¹Î¸âMâº
have Eq6: "âθ'âM. âp'âP. â¨Î¸,pâ© = <θ',p'> â§ (âF. M_generic(F) â§ p' â F â¶
M[F], map(val(P,F), [θ'] @ nenv @ [Ï]) ⨠?Ï)" by auto
from â¹ÏâM⺠â¹â¨Î¸,qâ©âÏâº
have "â¨Î¸,qâ© â M" by (simp add:transitivity)
from â¹â¨Î¸,qâ©âÏ⺠â¹Î¸âM⺠â¹pâP⺠â¹pâMâº
have "â¨Î¸,pâ©âM" "â¨Î¸,pâ©âdomain(Ï)ÃP"
using pair_in_M_iff by auto
with â¹Î¸âM⺠Eq6 â¹pâPâº
have "M, [â¨Î¸,pâ©] @ ?Pl1 @ [Ï] @ nenv ⨠?Ï"
using Equivalence by auto
with â¹â¨Î¸,pâ©âdomain(Ï)ÃPâº
have "â¨Î¸,pâ©â?n" by simp
with â¹pâG⺠â¹pâPâº
have "val(P,G,θ)âval(P,G,?n)"
using val_of_elem[of θ p] by simp
with â¹val(P,G,θ)=xâº
show "xâval(P,G,?n)" by simp
qed
with val_m first_incl
have "val(P,G,?n) = {xâc. (M[G], [x] @ env @ [c] ⨠Ï)}" by auto
also
have " ... = {xâc. (M[G], [x] @ env ⨠Ï)}"
proof -
{
fix x
assume "xâc"
moreover from assms
have "câM[G]"
unfolding GenExt_def by auto
moreover from this and â¹xâcâº
have "xâM[G]"
using transitivity_MG
by simp
ultimately
have "(M[G], ([x] @ env) @[c] ⨠Ï) â· (M[G], [x] @ env ⨠Ï)"
using phi â¹env â _⺠by (rule_tac arity_sats_iff, simp_all)
}
then show ?thesis by auto
qed
finally
show "{xâc. (M[G], [x] @ env ⨠Ï)}â M[G]"
using â¹?nâM⺠GenExt_def by force
qed
theorem separation_in_MG:
assumes
"Ïâformula" and "arity(Ï) ⤠1 +â©Ï length(env)" and "envâlist(M[G])"
shows
"separation(##M[G],λx. (M[G], [x] @ env ⨠Ï))"
proof -
{
fix c
assume "câM[G]"
moreover from â¹env â _âº
obtain nenv where "nenvâlist(M)"
"env = map(val(P,G),nenv)" "length(env) = length(nenv)"
using GenExt_def map_val[of env] by auto
moreover note â¹Ï â _⺠â¹arity(Ï) ⤠_⺠â¹env â _âº
ultimately
have Eq1: "{xâc. (M[G], [x] @ env ⨠Ï)} â M[G]"
using Collect_sats_in_MG by auto
}
then
show ?thesis
using separation_iff rev_bexI unfolding is_Collect_def by force
qed
end
end ody>
Theory Pairing_Axiom
sectionâ¹The Axiom of Pairing in $M[G]$âº
theory Pairing_Axiom
imports
Names
begin
context forcing_data1
begin
lemma val_Upair :
"ð â G â¹ val(P,G,{â¨Ï,ðâ©,â¨Ï,ðâ©}) = {val(P,G,Ï),val(P,G,Ï)}"
by (insert one_in_P, rule trans, subst def_val,auto)
lemma pairing_in_MG :
assumes "M_generic(G)"
shows "upair_ax(##M[G])"
proof -
from assms
have types: "ðâG" "ðâP" "ðâM"
using one_in_G one_in_M one_in_P
by simp_all
{
fix x y
note assms types
moreover
assume "x â M[G]" "y â M[G]"
moreover from this
obtain Ï Ï where "val(P,G,Ï) = x" "val(P,G,Ï) = y" "Ï â M" "Ï â M"
using GenExtD by blast
moreover from types this
have "â¨Ï,ðâ© â M" "â¨Ï,ðâ©âM"
using pair_in_M_iff by auto
moreover from this
have "{â¨Ï,ðâ©,â¨Ï,ðâ©} â M" (is "?Ï â _")
using upair_in_M_iff by simp
moreover from this
have "val(P,G,?Ï) â M[G]"
using GenExtI by simp
moreover from calculation
have "{val(P,G,Ï),val(P,G,Ï)} â M[G]"
using val_Upair assms one_in_G by simp
ultimately
have "{x,y} â M[G]"
by simp
}
then
show ?thesis
unfolding upair_ax_def upair_def by auto
qed
end
endy>
Theory Union_Axiom
sectionâ¹The Axiom of Unions in $M[G]$âº
theory Union_Axiom
imports Names
begin
definition Union_name_body :: "[i,i,i,i] â o" where
"Union_name_body(P,leq,Ï,x) â¡ â Ï . âqâP . ârâP .
â¨Ï,qâ© â Ï â§ â¨fst(x),râ© â Ï â§ â¨snd(x),râ© â leq â§ â¨snd(x),qâ© â leq"
relativize relational "Union_name_body" "is_Union_name_body"
reldb_add functional "Union_name_body" "is_Union_name_body"
synthesize "is_Union_name_body" from_definition assuming "nonempty"
arity_theorem for "is_Union_name_body_fm"
definition Union_name :: "[i,i,i] â i" where
"Union_name(P,leq,Ï) â¡ {u â domain(â(domain(Ï))) Ã P . Union_name_body(P,leq,Ï,u)}"
relativize functional "Union_name" "Union_name_rel"
relativize relational "Union_name" "is_Union_name"
synthesize "is_Union_name" from_definition assuming "nonempty"
arity_theorem for "is_Union_name_fm"
context M_basic
begin
is_iff_rel for "Union_name"
using transM[OF _ cartprod_closed] domain_closed Union_closed
unfolding is_Union_name_def Union_name_rel_def
by simp
lemma Union_name_body_iff:
assumes "M(x)" "M(leq)" "M(P)" "M(Ï)"
shows "is_Union_name_body(M, P, leq, Ï, x) â· Union_name_body(P, leq, Ï, x)"
proof -
from â¹M(Ï)âº
have "M(Ï)" if "â¨Ï,qâ©âÏ" for Ï q
using transM[of _ Ï] transM[of _ "â¨Ï,qâ©"] that
unfolding Pair_def
by auto
then
show ?thesis
using assms transM[OF _ cartprod_closed] pair_abs fst_abs snd_abs
unfolding is_Union_name_body_def Union_name_body_def
by auto
qed
lemma Union_name_abs :
assumes "M(P)" "M(leq)" "M(Ï)"
shows "Union_name_rel(M,P,leq,Ï) = Union_name(P,leq,Ï)"
using assms transM[OF _ cartprod_closed] Union_name_body_iff
unfolding Union_name_rel_def Union_name_def
by auto
end
context forcing_data1
begin
lemma Union_name_closed :
assumes "Ï â M"
shows "Union_name(P,leq,Ï) â M"
proof -
let ?Ï="is_Union_name_body_fm(3,2,1,0)"
let ?P="λ x . M,[x,Ï,leq,P] ⨠?Ï"
let ?Q="Union_name_body(P,leq,Ï)"
from â¹ÏâMâº
have "domain(â(domain(Ï)))âM" (is "?d â _")
using domain_closed Union_closed by simp
then
have "?d à P â M"
using cartprod_closed P_in_M by simp
note types = leq_in_M P_in_M assms â¹?dÃP â M⺠â¹?dâMâº
moreover
have "arity(?Ï)â¤4"
using arity_is_Union_name_body_fm ord_simp_union by simp
moreover from calculation
have "separation(##M,?P)"
using separation_ax by simp
moreover from calculation
have closed:"{ u â ?d à P . ?P(u) } â M"
using separation_iff by force
moreover from calculation
have "?P(x)â· xâM â§ ?Q(x)" if "xâ?dÃP" for x
proof -
note calculation that
moreover from this
have "x = â¨fst(x),snd(x)â©" "xâM" "fst(x) â M" "snd(x) â M"
using Pair_fst_snd_eq transitivity[of x "?dÃP"] fst_snd_closed
by simp_all
ultimately
show "?P(x) â· xâM â§ ?Q(x)"
using types zero_in_M is_Union_name_body_iff_sats Union_name_body_iff
by simp
qed
with â¹?d à P â M⺠types
have "Union_name_rel(##M,P,leq,Ï) â M"
unfolding Union_name_rel_def
using transitivity[OF _ â¹?dÃPâ_âº] Collect_cong closed Union_name_body_iff
by simp
ultimately
show ?thesis
using Union_name_abs
by simp
qed
lemma Union_MG_Eq :
assumes "a â M[G]" and "a = val(P,G,Ï)" and "filter(G)" and "Ï â M"
shows "â a = val(P,G,Union_name(P,leq,Ï))"
proof (intro equalityI subsetI)
fix x
assume "x â â a"
with â¹a=_âº
have "xâ â (val(P,G,Ï))"
by simp
then
obtain i where "i â val(P,G,Ï)" "x â i"
by blast
with â¹Ï â Mâº
obtain Ï q where "q â G" "â¨Ï,qâ© â Ï" "val(P,G,Ï) = i" "Ï â M"
using elem_of_val_pair domain_trans[OF trans_M]
by blast
moreover from this â¹x â iâº
obtain θ r where "r â G" "â¨Î¸,râ© â Ï" "val(P,G,θ) = x" "θ â M"
using elem_of_val_pair domain_trans[OF trans_M] by blast
moreover from calculation
have "θ â domain(â(domain(Ï)))"
by auto
moreover from calculation â¹filter(G)âº
obtain p where "p â G" "â¨p,râ© â leq" "â¨p,qâ© â leq" "p â P" "r â P" "q â P"
using low_bound_filter filterD by blast
moreover from this
have "p â M" "qâM" "râM"
using P_in_M by (auto dest:transM)
moreover from calculation
have "â¨Î¸,pâ© â Union_name(P,leq,Ï)"
unfolding Union_name_def Union_name_body_def
by auto
moreover from this â¹pâP⺠â¹pâGâº
have "val(P,G,θ) â val(P,G,Union_name(P,leq,Ï))"
using val_of_elem by simp
ultimately
show "x â val(P,G,Union_name(P,leq,Ï))"
by simp
next
fix x
assume "x â (val(P,G,Union_name(P,leq,Ï)))"
moreover
note â¹filter(G)⺠â¹a=val(P,G,Ï)âº
moreover from calculation
obtain θ p where "p â G" "â¨Î¸,pâ© â Union_name(P,leq,Ï)" "val(P,G,θ) = x"
using elem_of_val_pair by blast
moreover from calculation
have "pâP"
using filterD by simp
moreover from calculation
obtain Ï q r where "â¨Ï,qâ© â Ï" "â¨Î¸,râ© â Ï" "â¨p,râ© â leq" "â¨p,qâ© â leq" "râP" "qâP"
unfolding Union_name_def Union_name_body_def
by force
moreover from calculation
have "r â G" "q â G"
using filter_leqD by auto
moreover from this â¹â¨Î¸,râ© â Ï⺠â¹â¨Ï,qâ©âÏ⺠â¹qâP⺠â¹râPâº
have "val(P,G,Ï) â val(P,G,Ï)" "val(P,G,θ) â val(P,G,Ï)"
using val_of_elem by simp+
moreover from this
have "val(P,G,θ) â â val(P,G,Ï)"
by blast
ultimately
show "x â â a"
by simp
qed
lemma union_in_MG :
assumes "filter(G)"
shows "Union_ax(##M[G])"
unfolding Union_ax_def
proof(clarsimp)
fix a
assume "a â M[G]"
moreover
note â¹filter(G)âº
moreover from calculation
interpret mgtrans : M_trans "##M[G]"
using transitivity_MG by (unfold_locales; auto)
from calculation
obtain Ï where "Ï â M" "a=val(P,G,Ï)"
using GenExtD by blast
moreover from this
have "val(P,G,Union_name(P,leq,Ï)) â M[G]"
using GenExtI Union_name_closed P_in_M leq_in_M by simp
ultimately
show "âzâM[G] . big_union(##M[G],a,z)"
using Union_MG_Eq by auto
qed
theorem Union_MG : "M_generic(G) â¹ Union_ax(##M[G])"
by (simp add:M_generic_def union_in_MG)
end
endbody>
Theory Powerset_Axiom
sectionâ¹The Powerset Axiom in $M[G]$âº
theory Powerset_Axiom
imports Separation_Axiom Pairing_Axiom Union_Axiom
begin
simple_rename "perm_pow" src "[ss,p,l,o,fs,Ï]" tgt "[fs,ss,sp,p,l,o,Ï]"
lemma Collect_inter_Transset:
assumes
"Transset(M)" "b â M"
shows
"{xâb . P(x)} = {xâb . P(x)} â© M"
using assms unfolding Transset_def
by (auto)
context G_generic1
begin
lemma name_components_in_M:
assumes "â¨Ï,pâ©âθ" "θ â M"
shows "ÏâM" "pâM"
proof -
from assms
obtain a where "Ï â a" "p â a" "aââ¨Ï,pâ©"
unfolding Pair_def by auto
moreover from assms
have "â¨Ï,pâ©âM"
using transitivity by simp
moreover from calculation
have "aâM"
using transitivity by simp
ultimately
show "ÏâM" "pâM"
using transitivity by simp_all
qed
lemma sats_fst_snd_in_M:
assumes
"AâM" "BâM" "Ï â formula" "pâM" "lâM" "oâM" "ÏâM" "arity(Ï) ⤠6"
shows "{â¨s,qâ©âAÃB . M, [q,p,l,o,s,Ï] ⨠Ï} â M" (is "?θ â M")
proof -
let ?Ï' = "ren(Ï)`6`7`perm_pow_fn"
from â¹AâM⺠â¹BâMâº
have "AÃB â M"
using cartprod_closed by simp
from â¹arity(Ï) ⤠6⺠â¹Ïâ formulaâº
have "?Ï' â formula" "arity(?Ï')â¤7"
unfolding perm_pow_fn_def
using perm_pow_thm arity_ren ren_tc Nil_type
by auto
with â¹?Ï' â formulaâº
have arty: "arity(Exists(Exists(And(pair_fm(0,1,2),?Ï'))))â¤5" (is "arity(?Ï)â¤5")
using ord_simp_union pred_le
by (auto simp:arity)
{
fix sp
note â¹AÃB â M⺠â¹AâM⺠â¹BâMâº
moreover
assume "sp â AÃB"
moreover from calculation
have "fst(sp) â A" "snd(sp) â B"
using fst_type snd_type by simp_all
ultimately
have "sp â M" "fst(sp) â M" "snd(sp) â M"
using transitivity
by simp_all
note inM = â¹AâM⺠â¹BâM⺠â¹pâM⺠â¹lâM⺠â¹oâM⺠â¹ÏâMâº
â¹spâM⺠â¹fst(sp)âM⺠â¹snd(sp)âMâº
with arty â¹sp â M⺠â¹?Ï' â formulaâº
have "(M, [sp,p,l,o,Ï]@[p] ⨠?Ï) â· M,[sp,p,l,o,Ï] ⨠?Ï" (is "(M,?env0@ _â¨_) â· _")
using arity_sats_iff[of ?Ï "[p]" M ?env0] by auto
also from inM â¹sp â AÃBâº
have "... â· sats(M,?Ï',[fst(sp),snd(sp),sp,p,l,o,Ï])"
by auto
also from inM â¹Ï â formula⺠â¹arity(Ï) ⤠6âº
have "... â· M, [snd(sp),p,l,o,fst(sp),Ï] ⨠Ï"
(is "sats(_,_,?env1) â· sats(_,_,?env2)")
using sats_iff_sats_ren[of Ï 6 7 ?env2 M ?env1 perm_pow_fn] perm_pow_thm
unfolding perm_pow_fn_def by simp
finally
have "(M,[sp,p,l,o,Ï,p] ⨠?Ï) â· M, [snd(sp),p,l,o,fst(sp),Ï] ⨠Ï"
by simp
}
then
have "?θ = {spâAÃB . sats(M,?Ï,[sp,p,l,o,Ï,p])}"
by auto
also from assms â¹AÃBâMâº
have " ... â M"
proof -
from arty
have "arity(?Ï) ⤠6"
using leI by simp
moreover from â¹?Ï' â formulaâº
have "?Ï â formula"
by simp
moreover
note assms â¹AÃBâMâº
ultimately
show "{x â AÃB . M, [x, p, l, o, Ï, p] ⨠?Ï} â M"
using separation_ax separation_iff
by simp
qed
finally show ?thesis .
qed
lemma Pow_inter_MG:
assumes "aâM[G]"
shows "Pow(a) â© M[G] â M[G]"
proof -
from assms
obtain Ï where "Ï â M" "val(P,G, Ï) = a"
using GenExtD by auto
let ?Q="Pow(domain(Ï)ÃP) â© M"
from â¹ÏâMâº
have "domain(Ï)ÃP â M" "domain(Ï) â M"
using domain_closed cartprod_closed P_in_M
by simp_all
then
have "?Q â M"
proof -
from power_ax â¹domain(Ï)ÃP â Mâº
obtain Q where "powerset(##M,domain(Ï)ÃP,Q)" "Q â M"
unfolding power_ax_def by auto
moreover from calculation
have "zâQ â¹ zâM" for z
using transitivity by blast
ultimately
have "Q = {aâPow(domain(Ï)ÃP) . aâM}"
using â¹domain(Ï)ÃP â M⺠powerset_abs[of "domain(Ï)ÃP" Q]
by (simp flip: setclass_iff)
also
have " ... = ?Q"
by auto
finally
show ?thesis
using â¹QâM⺠by simp
qed
let ?Ï="?QÃ{ð}"
let ?b="val(P,G,?Ï)"
from â¹?QâMâº
have "?ÏâM"
using one_in_P P_in_M transitivity
by (simp flip: setclass_iff)
then
have "?b â M[G]"
using GenExtI by simp
have "Pow(a) â© M[G] â ?b"
proof
fix c
assume "c â Pow(a) â© M[G]"
then
obtain Ï where "câM[G]" "Ï â M" "val(P,G,Ï) = c"
using GenExt_iff by auto
let ?θ="{â¨Ï,pâ© âdomain(Ï)ÃP . p â© â
0 â 1â
[Ï,Ï] }"
have "arity(forces(Member(0,1))) = 6"
using arity_forces_at by auto
with â¹domain(Ï) â M⺠â¹Ï â Mâº
have "?θ â M"
using P_in_M one_in_M leq_in_M sats_fst_snd_in_M
by simp
then
have "?θ â ?Q" by auto
then
have "val(P,G,?θ) â ?b"
using one_in_G one_in_P generic val_of_elem [of ?θ ð ?Ï G]
by auto
have "val(P,G,?θ) = c"
proof(intro equalityI subsetI)
fix x
assume "x â val(P,G,?θ)"
then
obtain Ï p where 1: "â¨Ï,pâ©â?θ" "pâG" "val(P,G,Ï) = x"
using elem_of_val_pair
by blast
moreover from â¹â¨Ï,pâ©â?θ⺠â¹?θ â Mâº
have "ÏâM"
using name_components_in_M[of _ _ ?θ] by auto
moreover from 1
have "p â© â
0 â 1â
[Ï,Ï]" "pâP"
by simp_all
moreover
note â¹val(P,G,Ï) = c⺠â¹Ï â Mâº
ultimately
have "M[G], [x, c] ⨠â
0 â 1â
"
using generic definition_of_forcing[where Ï="â
0 â 1â
"] ord_simp_union
by auto
moreover from â¹ÏâM⺠â¹ÏâMâº
have "xâM[G]"
using â¹val(P,G,Ï) = x⺠GenExtI by blast
ultimately
show "xâc"
using â¹câM[G]⺠by simp
next
fix x
assume "x â c"
with â¹c â Pow(a) â© M[G]âº
have "x â a" "câM[G]" "xâM[G]"
using transitivity_MG by auto
with â¹val(P,G, Ï) = aâº
obtain Ï where "Ïâdomain(Ï)" "val(P,G,Ï) = x"
using elem_of_val by blast
moreover
note â¹xâc⺠â¹val(P,G,Ï) = c⺠â¹câM[G]⺠â¹xâM[G]âº
moreover from calculation
have "val(P,G,Ï) â val(P,G,Ï)"
by simp
moreover from calculation
have "M[G], [x, c] ⨠â
0 â 1â
"
by simp
moreover
have "ÏâM"
proof -
from â¹Ïâdomain(Ï)âº
obtain p where "â¨Ï,pâ© â Ï"
by auto
with â¹ÏâMâº
show ?thesis
using name_components_in_M by blast
qed
moreover
note â¹Ï â Mâº
ultimately
obtain p where "pâG" "p â© â
0 â 1â
[Ï,Ï]"
using generic truth_lemma[of "â
0 â 1â
" "G" "[Ï,Ï]" ] ord_simp_union
by auto
moreover from â¹pâGâº
have "pâP"
using generic by blast
ultimately
have "â¨Ï,pâ©â?θ"
using â¹Ïâdomain(Ï)⺠by simp
with â¹val(P,G,Ï) = x⺠â¹pâGâº
show "xâval(P,G,?θ)"
using val_of_elem [of _ _ "?θ"] by auto
qed
with â¹val(P,G,?θ) â ?bâº
show "câ?b"
by simp
qed
then
have "Pow(a) â© M[G] = {xâ?b . xâa â§ xâM[G]}"
by auto
also from â¹aâM[G]âº
have " ... = {xâ?b . ( M[G], [x,a] ⨠â
0 â 1â
) â§ xâM[G]}"
using Transset_MG by force
also
have " ... = {xâ?b . ( M[G], [x,a] ⨠â
0 â 1â
)} â© M[G]"
by auto
also from â¹?bâM[G]âº
have " ... = {xâ?b . ( M[G], [x,a] ⨠â
0 â 1â
)}"
using Collect_inter_Transset Transset_MG
by simp
also from â¹?bâM[G]⺠â¹aâM[G]âº
have " ... â M[G]"
using Collect_sats_in_MG GenExtI ord_simp_union by (simp add:arity)
finally
show ?thesis .
qed
end
sublocale G_generic1 â ext: M_trivial "##M[G]"
using generic Union_MG pairing_in_MG zero_in_MG transitivity_MG
unfolding M_trivial_def M_trans_def M_trivial_axioms_def
by (simp; blast)
context G_generic1 begin
theorem power_in_MG : "power_ax(##(M[G]))"
unfolding power_ax_def
proof (intro rallI, simp only:setclass_iff rex_setclass_is_bex)
fix a
assume "a â M[G]"
then
have "(##M[G])(a)"
by simp
have "{xâPow(a) . x â M[G]} = Pow(a) â© M[G]"
by auto
also from â¹aâM[G]âº
have " ... â M[G]"
using Pow_inter_MG by simp
finally
have "{xâPow(a) . x â M[G]} â M[G]" .
moreover from â¹aâM[G]⺠â¹{xâPow(a) . x â M[G]} â _âº
have "powerset(##M[G], a, {xâPow(a) . x â M[G]})"
using ext.powerset_abs[OF â¹(##M[G])(a)âº]
by simp
ultimately
show "âxâM[G] . powerset(##M[G], a, x)"
by auto
qed
end
endd>
Theory Extensionality_Axiom
sectionâ¹The Axiom of Extensionality in $M[G]$âº
theory Extensionality_Axiom
imports
Names
begin
context forcing_data1
begin
lemma extensionality_in_MG : "extensionality(##(M[G]))"
unfolding extensionality_def
proof(clarsimp)
fix x y
assume "xâM[G]" "yâM[G]" "(âwâM[G] . w â x â· w â y)"
moreover from this
have "zâx â· zâM[G] â§ zây" for z
using transitivity_MG by auto
moreover from calculation
have "zâM[G] â§ zâx â· zây" for z
using transitivity_MG by auto
ultimately
show "x=y"
by auto
qed
end
end
Theory Foundation_Axiom
sectionâ¹The Axiom of Foundation in $M[G]$âº
theory Foundation_Axiom
imports
Names
begin
context forcing_data1
begin
lemma foundation_in_MG : "foundation_ax(##(M[G]))"
unfolding foundation_ax_def
by (rule rallI, cut_tac A=x in foundation, auto intro: transitivity_MG)
lemma "foundation_ax(##(M[G]))"
proof -
{
fix x
assume "xâM[G]" "âyâM[G] . yâx"
then
have "âyâM[G] . yâxâ©M[G]"
by simp
then
obtain y where "yâxâ©M[G]" "âzây. z â xâ©M[G]"
using foundation[of "xâ©M[G]"] by blast
then
have "âyâM[G] . y â x â§ (âzâM[G] . z â x ⨠z â y)"
by auto
}
then
show ?thesis
unfolding foundation_ax_def by auto
qed
end
end
Theory Replacement_Axiom
sectionâ¹The Axiom of Replacement in $M[G]$âº
theory Replacement_Axiom
imports
Separation_Axiom
begin
context forcing_data1
begin
bundle sharp_simps1 = snd_abs[simp] fst_abs[simp] fst_closed[simp del, simplified, simp]
snd_closed[simp del, simplified, simp] M_inhabited[simplified, simp]
pair_in_M_iff[simp del, simplified, simp]
lemma sats_forces_iff_sats_rename_split_fm:
includes sharp_simps1
assumes
"[α,m,p,P,leq,ð,t,Ï] @ nenv âlist(M)" "V â M"
"Ïâformula"
shows
"(M, [p, P, leq, ð, t, Ï] @ nenv ⨠forces(Ï)) â·
M, [V, Ï, α, â¨t,pâ©, m, P, leq, ð] @ nenv ⨠rename_split_fm(Ï)"
using assms unfolding rename_split_fm_def
by (simp add:sats_incr_bv_iff[where bvs="[_,_,_,_,_,_]", simplified])
lemma sats_body_ground_repl_fm:
includes sharp_simps1
assumes
"ât p. x=â¨t,pâ©" "[x,α,m,P,leq,ð] @ nenv âlist(M)"
"Ïâformula"
shows
"(âÏâM. âVâM. is_Vset(λa. (##M)(a),α,V) â§ Ï â V â§ (snd(x) â© Ï ([fst(x),Ï]@nenv)))
â· M, [α, x, m, P, leq, ð] @ nenv ⨠body_ground_repl_fm(Ï)"
proof -
{
fix Ï V t p
assume "Ï â M" "V â M" "x = â¨t, pâ©" "t â M" "p â M"
with assms
have "Ï â V â§ (M, [p,P,leq,ð,t,Ï] @ nenv ⨠forces(Ï)) â·
Ï â V â§ (M, [V,Ï,α,â¨t, pâ©,m,P, leq, ð] @ nenv ⨠rename_split_fm(Ï))"
using sats_forces_iff_sats_rename_split_fm[of α m p t Ï, where nenv=nenv and Ï=Ï]
by auto
}
note eq = this
show ?thesis
unfolding body_ground_repl_fm_def
apply (insert assms)
apply (rule iff_sats | simp add:nonempty[simplified])+
using eq
by (auto del: iffI)
qed
end
context G_generic1
begin
lemma Replace_sats_in_MG:
assumes
"câM[G]" "env â list(M[G])"
"Ï â formula" "arity(Ï) ⤠2 +â©Ï length(env)"
"univalent(##M[G], c, λx v. (M[G] , [x,v]@env ⨠Ï) )"
and
ground_replacement:
"ânenv. ground_replacement_assm(M,[P,leq,ð] @ nenv, Ï)"
shows
"{v. xâc, vâM[G] â§ (M[G] , [x,v]@env ⨠Ï)} â M[G]"
proof -
let ?R = "λ x v . vâM[G] â§ (M[G] , [x,v]@env ⨠Ï)"
from â¹câM[G]âº
obtain Ï' where "val(P,G, Ï') = c" "Ï' â M"
using GenExt_def by auto
then
have "domain(Ï')ÃPâM" (is "?ÏâM")
using cartprod_closed P_in_M domain_closed by simp
from â¹val(P,G, Ï') = câº
have "c â val(P,G,?Ï)"
using def_val[of G ?Ï] one_in_P one_in_G[OF generic] elem_of_val
domain_of_prod[OF one_in_P, of "domain(Ï')"] by force
from â¹env â _âº
obtain nenv where "nenvâlist(M)" "env = map(val(P,G),nenv)"
using map_val by auto
then
have "length(nenv) = length(env)" by simp
define f where "f(Ïp) ⡠μ α. αâM â§ (âÏâM. Ï â Vset(α) â§
(snd(Ïp) â© Ï ([fst(Ïp),Ï] @ nenv)))" (is "_ ⡠μ α. ?P(Ïp,α)") for Ïp
have "f(Ïp) = (μ α. αâM â§ (âÏâM. âVâM. is_Vset(##M,α,V) â§ ÏâV â§
(snd(Ïp) â© Ï ([fst(Ïp),Ï] @ nenv))))" (is "_ = (μ α. αâM â§ ?Q(Ïp,α))") for Ïp
unfolding f_def using Vset_abs Vset_closed Ord_Least_cong[of "?P(Ïp)" "λ α. αâM â§ ?Q(Ïp,α)"]
by (simp, simp del:setclass_iff)
moreover
have "f(Ïp) â M" for Ïp
unfolding f_def using Least_closed'[of "?P(Ïp)"] by simp
ultimately
have 1:"least(##M,λα. ?Q(Ïp,α),f(Ïp))" for Ïp
using least_abs'[of "λα. αâM â§ ?Q(Ïp,α)" "f(Ïp)"] least_conj
by (simp flip: setclass_iff)
have "Ord(f(Ïp))" for Ïp unfolding f_def by simp
define QQ where "QQâ¡?Q"
from 1
have "least(##M,λα. QQ(Ïp,α),f(Ïp))" for Ïp
unfolding QQ_def .
from â¹arity(Ï) ⤠_⺠â¹length(nenv) = _âº
have "arity(Ï) ⤠2 +â©Ï length(nenv)"
by simp
moreover
note assms â¹nenvâlist(M)⺠â¹?ÏâMâº
moreover
have "Ïpâ?Ï â¹ ât p. Ïp=â¨t,pâ©" for Ïp
by auto
ultimately
have body:"(M , [α,Ïp,m,P,leq,ð] @ nenv ⨠body_ground_repl_fm(Ï)) â· ?Q(Ïp,α)"
if "Ïpâ?Ï" "ÏpâM" "mâM" "αâM" for α Ïp m
using that P_in_M leq_in_M one_in_M sats_body_ground_repl_fm[of Ïp α m nenv Ï] by simp
{
fix Ïp m
assume asm: "ÏpâM" "Ïpâ?Ï" "mâM"
note inM = this P_in_M leq_in_M one_in_M â¹nenvâlist(M)âº
with body
have body':"âα. α â M â¹ (âÏâM. âVâM. is_Vset(λa. (##M)(a), α, V) â§ Ï â V â§
(snd(Ïp) â© Ï ([fst(Ïp),Ï] @ nenv))) â·
M, Cons(α, [Ïp, m, P, leq, ð] @ nenv) ⨠body_ground_repl_fm(Ï)" by simp
from inM
have "(M , [Ïp,m,P,leq,ð] @ nenv ⨠ground_repl_fm(Ï)) â· least(##M, QQ(Ïp), m)"
using sats_least_fm[OF body', of 1] unfolding QQ_def ground_repl_fm_def
by (simp, simp flip: setclass_iff)
}
then
have "(M, [Ïp,m,P,leq,ð] @ nenv ⨠ground_repl_fm(Ï)) â· least(##M, QQ(Ïp), m)"
if "ÏpâM" "Ïpâ?Ï" "mâM" for Ïp m using that by simp
then
have "univalent(##M, ?Ï, λÏp m. M , [Ïp,m] @ ([P,leq,ð] @ nenv) ⨠ground_repl_fm(Ï))"
unfolding univalent_def by (auto intro:unique_least)
moreover from â¹length(_) = _⺠â¹env â _âº
have "length([P,leq,ð] @ nenv) = 3 +â©Ï length(env)" by simp
moreover from â¹arity(Ï) ⤠2 +â©Ï length(nenv)âº
â¹length(_) = length(_)âº[symmetric] â¹nenvâ_⺠â¹Ïâ_âº
have "arity(ground_repl_fm(Ï)) ⤠5 +â©Ï length(env)"
using arity_ground_repl_fm[of Ï] le_trans Un_le by auto
moreover from â¹Ïâformulaâº
have "ground_repl_fm(Ï)âformula" by simp
moreover
note inM = P_in_M leq_in_M one_in_M â¹nenvâlist(M)⺠â¹?ÏâMâº
moreover
note â¹length(nenv) = length(env)âº
ultimately
obtain Y where "YâM"
"âmâM. m â Y â· (âÏpâM. Ïp â ?Ï â§ (M, [Ïp,m] @ ([P,leq,ð] @ nenv) ⨠ground_repl_fm(Ï)))"
using ground_replacement[of nenv]
unfolding strong_replacement_def ground_replacement_assm_def replacement_assm_def by auto
with â¹least(_,QQ(_),f(_))⺠â¹f(_) â M⺠â¹?ÏâMâº
â¹_ â¹ _ â¹ _ â¹ (M,_ ⨠ground_repl_fm(Ï)) â· least(_,_,_)âº
have "f(Ïp)âY" if "Ïpâ?Ï" for Ïp
using that transitivity[OF _ â¹?ÏâMâº]
by (clarsimp, rule_tac x="â¨x,yâ©" in bexI, auto)
moreover
have "{yâY. Ord(y)} â M"
using â¹YâM⺠separation_ax sats_ordinal_fm trans_M
separation_cong[of "##M" "λy. sats(M,ordinal_fm(0),[y])" "Ord"]
separation_closed by (simp add:arity)
then
have "â {yâY. Ord(y)} â M" (is "?sup â M")
using Union_closed by simp
then
have "{xâVset(?sup). x â M} â M"
using Vset_closed by simp
moreover
have "{ð} â M"
using one_in_M singleton_closed by simp
ultimately
have "{xâVset(?sup). x â M} Ã {ð} â M" (is "?big_name â M")
using cartprod_closed by simp
then
have "val(P,G,?big_name) â M[G]"
by (blast intro:GenExtI)
{
fix v x
assume "xâc"
moreover
note â¹val(P,G,Ï')=c⺠â¹Ï'âMâº
moreover
from calculation
obtain Ï p where "â¨Ï,pâ©âÏ'" "val(P,G,Ï) = x" "pâG" "ÏâM"
using elem_of_val_pair'[of Ï' x G] by blast
moreover
assume "vâM[G]"
then
obtain Ï where "val(P,G,Ï) = v" "ÏâM"
using GenExtD by auto
moreover
assume "sats(M[G], Ï, [x,v] @ env)"
moreover
note â¹Ïâ_⺠â¹nenvâ_⺠â¹env = _⺠â¹arity(Ï)⤠2 +â©Ï length(env)âº
ultimately
obtain q where "qâG" "q â© Ï ([Ï,Ï]@nenv)"
using truth_lemma[OF â¹Ïâ_⺠generic, symmetric, of "[Ï,Ï] @ nenv"]
by auto
with â¹â¨Ï,pâ©âÏ'⺠â¹â¨Ï,qâ©â?Ï â¹ f(â¨Ï,qâ©)âYâº
have "f(â¨Ï,qâ©)âY"
using generic unfolding M_generic_def filter_def by blast
let ?α="succ(rank(Ï))"
note â¹ÏâMâº
moreover from this
have "?α â M"
using rank_closed cons_closed by (simp flip: setclass_iff)
moreover
have "Ï â Vset(?α)"
using Vset_Ord_rank_iff by auto
moreover
note â¹q â© Ï ([Ï,Ï] @ nenv)âº
ultimately
have "?P(â¨Ï,qâ©,?α)" by (auto simp del: Vset_rank_iff)
moreover
have "(μ α. ?P(â¨Ï,qâ©,α)) = f(â¨Ï,qâ©)"
unfolding f_def by simp
ultimately
obtain Ï where "ÏâM" "Ï â Vset(f(â¨Ï,qâ©))" "q â© Ï ([Ï,Ï] @ nenv)"
using LeastI[of "λ α. ?P(â¨Ï,qâ©,α)" ?α] by auto
with â¹qâG⺠â¹ÏâM⺠â¹nenvâ_⺠â¹arity(Ï)⤠2 +â©Ï length(nenv)âº
have "M[G], map(val(P,G),[Ï,Ï] @ nenv) ⨠Ï"
using truth_lemma[OF â¹Ïâ_⺠generic, of "[Ï,Ï] @ nenv"] by auto
moreover from â¹xâc⺠â¹câM[G]âº
have "xâM[G]" using transitivity_MG by simp
moreover
note â¹M[G],[x,v] @ env⨠Ï⺠â¹env = map(val(P,G),nenv)⺠â¹ÏâM⺠â¹val(P,G,Ï)=xâº
â¹univalent(##M[G],_,_)⺠â¹xâc⺠â¹vâM[G]âº
ultimately
have "v=val(P,G,Ï)"
using GenExtI[of Ï G] unfolding univalent_def by (auto)
from â¹Ï â Vset(f(â¨Ï,qâ©))⺠â¹Ord(f(_))⺠â¹f(â¨Ï,qâ©)âYâº
have "Ï â Vset(?sup)"
using Vset_Ord_rank_iff lt_Union_iff[of _ "rank(Ï)"] by auto
with â¹ÏâMâº
have "val(P,G,Ï) â val(P,G,?big_name)"
using domain_of_prod[of ð "{ð}" "{xâVset(?sup). x â M}" ] def_val[of G ?big_name]
one_in_G[OF generic] one_in_P by (auto simp del: Vset_rank_iff)
with â¹v=val(P,G,Ï)âº
have "v â val(P,G,{xâVset(?sup). x â M} Ã {ð})"
by simp
}
then
have "{v. xâc, ?R(x,v)} â val(P,G,?big_name)" (is "?replâ?big")
by blast
with â¹?big_nameâMâº
have "?repl = {vâ?big. âxâc. sats(M[G], Ï, [x,v] @ env )}" (is "_ = ?rhs")
proof(intro equalityI subsetI)
fix v
assume "vâ?repl"
with â¹?replâ?bigâº
obtain x where "xâc" "M[G], [x, v] @ env ⨠Ï" "vâ?big"
using subsetD by auto
with â¹univalent(##M[G],_,_)⺠â¹câM[G]âº
show "v â ?rhs"
unfolding univalent_def
using transitivity_MG ReplaceI[of "λ x v. âxâc. M[G], [x, v] @ env ⨠Ï"] by blast
next
fix v
assume "vâ?rhs"
then
obtain x where
"vâval(P,G, ?big_name)" "M[G], [x, v] @ env ⨠Ï" "xâc"
by blast
moreover from this â¹câM[G]âº
have "vâM[G]" "xâM[G]"
using transitivity_MG GenExtI[OF â¹?big_nameâ_âº,of G] by auto
moreover from calculation â¹univalent(##M[G],_,_)âº
have "?R(x,y) â¹ y = v" for y
unfolding univalent_def by auto
ultimately
show "vâ?repl"
using ReplaceI[of ?R x v c]
by blast
qed
moreover
let ?Ï = "Exists(And(Member(0,2+â©Ïlength(env)),Ï))"
have "vâM[G] â¹ (âxâc. M[G], [x,v] @ env ⨠Ï) â· M[G], [v] @ env @ [c] ⨠?Ï"
"arity(?Ï) ⤠2 +â©Ï length(env)" "?Ïâformula"
for v
proof -
fix v
assume "vâM[G]"
with â¹câM[G]âº
have "nth(length(env)+â©Ï1,[v]@env@[c]) = c"
using â¹envâ_âºnth_concat[of v c "M[G]" env]
by auto
note inMG= â¹nth(length(env)+â©Ï1,[v]@env@[c]) = c⺠â¹câM[G]⺠â¹vâM[G]⺠â¹envâ_âº
show "(âxâc. M[G], [x,v] @ env ⨠Ï) â· M[G], [v] @ env @ [c] ⨠?Ï"
proof
assume "âxâc. M[G], [x, v] @ env ⨠Ï"
then obtain x where
"xâc" "M[G], [x, v] @ env ⨠Ï" "xâM[G]"
using transitivity_MG[OF _ â¹câM[G]âº]
by auto
with â¹Ïâ_⺠â¹arity(Ï)â¤2+â©Ïlength(env)⺠inMG
show "M[G], [v] @ env @ [c] ⨠Exists(And(Member(0, 2 +â©Ï length(env)), Ï))"
using arity_sats_iff[of Ï "[c]" _ "[x,v]@env"]
by auto
next
assume "M[G], [v] @ env @ [c] ⨠Exists(And(Member(0, 2 +â©Ï length(env)), Ï))"
with inMG
obtain x where
"xâM[G]" "xâc" "M[G], [x,v]@env@[c] ⨠Ï"
by auto
with â¹Ïâ_⺠â¹arity(Ï)â¤2+â©Ïlength(env)⺠inMG
show "âxâc. M[G], [x, v] @ env⨠Ï"
using arity_sats_iff[of Ï "[c]" _ "[x,v]@env"]
by auto
qed
next
from â¹envâ_⺠â¹Ïâ_âº
show "arity(?Ï)â¤2+â©Ïlength(env)"
using pred_mono[OF _ â¹arity(Ï)â¤2+â©Ïlength(env)âº] lt_trans[OF _ le_refl]
by (auto simp add:ord_simp_union arity)
next
from â¹Ïâ_âº
show "?Ïâformula" by simp
qed
moreover from this
have "{vâ?big. âxâc. M[G], [x,v] @ env ⨠Ï} = {vâ?big. M[G], [v] @ env @ [c] ⨠?Ï}"
using transitivity_MG[OF _ GenExtI, OF _ â¹?big_nameâMâº]
by simp
moreover from calculation and â¹envâ_⺠â¹câ_⺠â¹?bigâM[G]âº
have "{vâ?big. M[G] , [v] @ env @ [c] ⨠?Ï} â M[G]"
using Collect_sats_in_MG by auto
ultimately
show ?thesis by simp
qed
theorem strong_replacement_in_MG:
assumes
"Ïâformula" and "arity(Ï) ⤠2 +â©Ï length(env)" "env â list(M[G])"
and
ground_replacement:
"ânenv. ground_replacement_assm(M,[P,leq,ð] @ nenv, Ï)"
shows
"strong_replacement(##M[G],λx v. sats(M[G],Ï,[x,v] @ env))"
proof -
let ?R="λx y . M[G], [x, y] @ env ⨠Ï"
{
fix A
let ?Y="{v . x â A, vâM[G] â§ ?R(x,v)}"
assume 1: "(##M[G])(A)"
"âx[##M[G]]. x â A â¶ (ây[##M[G]]. âz[##M[G]]. ?R(x,y) â§ ?R(x,z) â¶ y = z)"
then
have "univalent(##M[G], A, ?R)" "AâM[G]"
unfolding univalent_def by simp_all
with assms â¹Aâ_âº
have "(##M[G])(?Y)"
using Replace_sats_in_MG ground_replacement
unfolding ground_replacement_assm_def by (auto)
have "b â ?Y â· (âx[##M[G]]. x â A â§ ?R(x,b))" if "(##M[G])(b)" for b
proof(rule)
from â¹Aâ_âº
show "âx[##M[G]]. x â A â§ ?R(x,b)" if "b â ?Y"
using that transitivity_MG by auto
next
show "b â ?Y" if "âx[##M[G]]. x â A â§ ?R(x,b)"
proof -
from â¹(##M[G])(b)âº
have "bâM[G]" by simp
with that
obtain x where "(##M[G])(x)" "xâA" "bâM[G] â§ ?R(x,b)"
by blast
moreover from this 1 â¹(##M[G])(b)âº
have "xâM[G]" "zâM[G] â§ ?R(x,z) â¹ b = z" for z
by auto
ultimately
show ?thesis
using ReplaceI[of "λ x y. yâM[G] â§ ?R(x,y)"] by blast
qed
qed
then
have "âb[##M[G]]. b â ?Y â· (âx[##M[G]]. x â A â§ ?R(x,b))"
by simp
with â¹(##M[G])(?Y)âº
have " (âY[##M[G]]. âb[##M[G]]. b â Y â· (âx[##M[G]]. x â A â§ ?R(x,b)))"
by auto
}
then show ?thesis unfolding strong_replacement_def univalent_def
by auto
qed
lemma replacement_assm_MG:
assumes
ground_replacement:
"ânenv. ground_replacement_assm(M,[P,leq,ð] @ nenv, Ï)"
shows
"replacement_assm(M[G],env,Ï)"
using assms strong_replacement_in_MG
unfolding replacement_assm_def by simp
end
end body>
Theory Infinity_Axiom
sectionâ¹The Axiom of Infinity in $M[G]$âº
theory Infinity_Axiom
imports Separation_Axiom Union_Axiom Pairing_Axiom
begin
context G_generic1 begin
interpretation mg_triv: M_trivial"##M[G]"
using transitivity_MG zero_in_MG generic Union_MG pairing_in_MG
by unfold_locales auto
lemma infinity_in_MG : "infinity_ax(##M[G])"
proof -
from infinity_ax
obtain I where "IâM" "0 â I" "âyâM. y â I â¶ succ(y) â I"
unfolding infinity_ax_def by auto
then
have "check(I) â M"
using check_in_M by simp
then
have "Iâ M[G]"
using valcheck generic one_in_G one_in_P GenExtI[of "check(I)" G] by simp
moreover from this â¹IâM[G]⺠â¹âyâM. y â I â¶ succ(y) â Iâº
have "succ(y) â I â© M[G]" if "y â I" for y
using that transitivity_MG transitivity[OF _ â¹IâMâº] by blast
moreover
note â¹0âIâº
ultimately
show ?thesis
using transitivity_MG[of _ I]
unfolding infinity_ax_def
by auto
qed
end
enddy>
Theory Choice_Axiom
sectionâ¹The Axiom of Choice in $M[G]$âº
theory Choice_Axiom
imports
Powerset_Axiom
Extensionality_Axiom
Foundation_Axiom
Replacement_Axiom
Infinity_Axiom
begin
definition
induced_surj :: "iâiâiâi" where
"induced_surj(f,a,e) â¡ f-``(range(f)-a)Ã{e} ⪠restrict(f,f-``a)"
lemma domain_induced_surj: "domain(induced_surj(f,a,e)) = domain(f)"
unfolding induced_surj_def using domain_restrict domain_of_prod by auto
lemma range_restrict_vimage:
assumes "function(f)"
shows "range(restrict(f,f-``a)) â a"
proof
from assms
have "function(restrict(f,f-``a))"
using function_restrictI by simp
fix y
assume "y â range(restrict(f,f-``a))"
then
obtain x where "â¨x,yâ© â restrict(f,f-``a)" "x â f-``a" "xâdomain(f)"
using domain_restrict domainI[of _ _ "restrict(f,f-``a)"] by auto
moreover
note â¹function(restrict(f,f-``a))âº
ultimately
have "y = restrict(f,f-``a)`x"
using function_apply_equality by blast
also from â¹x â f-``aâº
have "restrict(f,f-``a)`x = f`x"
by simp
finally
have "y = f`x" .
moreover from assms â¹xâdomain(f)âº
have "â¨x,f`xâ© â f"
using function_apply_Pair by auto
moreover
note assms â¹x â f-``aâº
ultimately
show "yâa"
using function_image_vimage[of f a] by auto
qed
lemma induced_surj_type:
assumes "function(f)"
shows
"induced_surj(f,a,e): domain(f) â {e} ⪠a"
and
"x â f-``a â¹ induced_surj(f,a,e)`x = f`x"
proof -
let ?f1="f-``(range(f)-a) Ã {e}" and ?f2="restrict(f, f-``a)"
have "domain(?f2) = domain(f) â© f-``a"
using domain_restrict by simp
moreover from assms
have "domain(?f1) = f-``(range(f))-f-``a"
using domain_of_prod function_vimage_Diff by simp
ultimately
have "domain(?f1) â© domain(?f2) = 0"
by auto
moreover
have "function(?f1)" "relation(?f1)" "range(?f1) â {e}"
unfolding function_def relation_def range_def by auto
moreover from this and assms
have "?f1: domain(?f1) â range(?f1)"
using function_imp_Pi by simp
moreover from assms
have "?f2: domain(?f2) â range(?f2)"
using function_imp_Pi[of "restrict(f, f -`` a)"] function_restrictI by simp
moreover from assms
have "range(?f2) â a"
using range_restrict_vimage by simp
ultimately
have "induced_surj(f,a,e): domain(?f1) ⪠domain(?f2) â {e} ⪠a"
unfolding induced_surj_def using fun_is_function fun_disjoint_Un fun_weaken_type by simp
moreover
have "domain(?f1) ⪠domain(?f2) = domain(f)"
using domain_restrict domain_of_prod by auto
ultimately
show "induced_surj(f,a,e): domain(f) â {e} ⪠a"
by simp
assume "x â f-``a"
then
have "?f2`x = f`x"
using restrict by simp
moreover from â¹x â f-``a⺠â¹domain(?f1) = _âº
have "x â domain(?f1)"
by simp
ultimately
show "induced_surj(f,a,e)`x = f`x"
unfolding induced_surj_def using fun_disjoint_apply2[of x ?f1 ?f2] by simp
qed
lemma induced_surj_is_surj :
assumes
"eâa" "function(f)" "domain(f) = α" "ây. y â a â¹ âxâα. f ` x = y"
shows "induced_surj(f,a,e) â surj(α,a)"
unfolding surj_def
proof (intro CollectI ballI)
from assms
show "induced_surj(f,a,e): α â a"
using induced_surj_type[of f a e] cons_eq cons_absorb by simp
fix y
assume "y â a"
with assms
have "âxâα. f ` x = y"
by simp
then
obtain x where "xâα" "f ` x = y" by auto
with â¹yâa⺠assms
have "xâf-``a"
using vimage_iff function_apply_Pair[of f x] by auto
with â¹f ` x = y⺠assms
have "induced_surj(f, a, e) ` x = y"
using induced_surj_type by simp
with â¹xâα⺠show
"âxâα. induced_surj(f, a, e) ` x = y" by auto
qed
context G_generic1
begin
lemma upair_name_abs :
assumes "xâM" "yâM" "zâM" "oâM"
shows "is_upair_name(##M,x,y,o,z) â· z = upair_name(x,y,o)"
unfolding is_upair_name_def upair_name_def
using assms zero_in_M pair_in_M_iff Upair_eq_cons
by simp
lemma upair_name_closed :
"⦠xâM; yâM ; oâMâ§ â¹ upair_name(x,y,o)âM"
unfolding upair_name_def
using upair_in_M_iff pair_in_M_iff Upair_eq_cons
by simp
lemma opair_name_abs :
assumes "xâM" "yâM" "zâM" "oâM"
shows "is_opair_name(##M,x,y,o,z) â· z = opair_name(x,y,o)"
unfolding is_opair_name_def opair_name_def
using assms upair_name_abs upair_name_closed
by simp
lemma opair_name_closed :
"⦠xâM; yâM ; oâM â§ â¹ opair_name(x,y,o)âM"
unfolding opair_name_def
using upair_name_closed by simp
lemma val_upair_name : "val(P,G,upair_name(Ï,Ï,ð)) = {val(P,G,Ï),val(P,G,Ï)}"
unfolding upair_name_def
using val_Upair Upair_eq_cons generic one_in_G one_in_P
by simp
lemma val_opair_name : "val(P,G,opair_name(Ï,Ï,ð)) = â¨val(P,G,Ï),val(P,G,Ï)â©"
unfolding opair_name_def Pair_def
using val_upair_name by simp
lemma val_RepFun_one: "val(P,G,{â¨f(x),ðâ© . xâa}) = {val(P,G,f(x)) . xâa}"
proof -
let ?A = "{f(x) . x â a}"
let ?Q = "λâ¨x,pâ© . p = ð"
have "ð â Pâ©G" using generic one_in_G one_in_P by simp
have "{â¨f(x),ðâ© . x â a} = {t â ?A à P . ?Q(t)}"
using one_in_P by force
then
have "val(P,G,{â¨f(x),ðâ© . x â a}) = val(P,G,{t â ?A à P . ?Q(t)})"
by simp
also
have "... = {z . t â ?A , (âpâPâ©G . ?Q(â¨t,pâ©)) â§ z= val(P,G,t)}"
using val_of_name_alt by simp
also
have "... = {val(P,G,t) . t â ?A }"
using â¹ðâPâ©G⺠by force
also
have "... = {val(P,G,f(x)) . x â a}"
by auto
finally
show ?thesis
by simp
qed
lemmas generic_simps = generic[THEN one_in_G, THEN valcheck, OF one_in_P]
generic[THEN one_in_G, THEN M_subset_MG, THEN subsetD]
check_in_M GenExtI P_in_M
lemmas generic_dests = M_genericD[OF generic] M_generic_compatD[OF generic]
bundle G_generic1_lemmas = generic_simps[simp] generic_dests[dest]
end
subsectionâ¹$M[G]$ is a transitive model of ZFâº
sublocale G_generic1 â ext:M_Z_trans "M[G]"
using Transset_MG generic pairing_in_MG Union_MG
extensionality_in_MG power_in_MG foundation_in_MG
replacement_assm_MG separation_in_MG infinity_in_MG
replacement_ax1 by unfold_locales
context G_generic1
begin
lemma opname_check_abs :
assumes "sâM" "xâM" "yâM"
shows "is_opname_check(##M,ð,s,x,y) â· y = opair_name(check(x),s`x,ð)"
unfolding is_opname_check_def
using assms check_abs check_in_M opair_name_abs apply_abs apply_closed one_in_M
by simp
lemma repl_opname_check :
assumes "AâM" "fâM"
shows "{opair_name(check(x),f`x,ð). xâA}âM"
proof -
have "arity(is_opname_check_fm(3,2,0,1))= 4"
using arity_is_opname_check_fm
by (simp add:ord_simp_union arity)
moreover
have "opair_name(check(x), f ` x,ð)âM" if "xâA" for x
using assms opair_name_closed apply_closed transitivity check_in_M one_in_M that
by simp
ultimately
show ?thesis
using assms opname_check_abs[of f] is_opname_check_iff_sats
one_in_M zero_in_M transitivity
Replace_relativized_in_M[of "is_opname_check_fm(3,2,0,1)"
"[f,ð]" _ "is_opname_check(##M,ð,f)"] replacement_ax1(14)
by simp
qed
theorem choice_in_MG:
assumes "choice_ax(##M)"
shows "choice_ax(##M[G])"
proof -
{
fix a
assume "aâM[G]"
then
obtain Ï where "ÏâM" "val(P,G,Ï) = a"
using GenExt_def by auto
with â¹ÏâMâº
have "domain(Ï)âM"
using domain_closed by simp
then
obtain s α where "sâsurj(α,domain(Ï))" "Ord(α)" "sâM" "αâM"
using assms choice_ax_abs
by auto
then
have "뱉M[G]"
using M_subset_MG generic one_in_G subsetD
by blast
let ?A="domain(Ï)ÃP"
let ?g = "{opair_name(check(β),s`β,ð). βâα}"
have "?g â M"
using â¹sâM⺠â¹Î±âM⺠repl_opname_check
by simp
let ?f_dot="{â¨opair_name(check(β),s`β,ð),ðâ©. βâα}"
have "?f_dot = ?g à {ð}" by blast
define f where
"f â¡ val(P,G,?f_dot)"
from â¹?gâM⺠â¹?f_dot = ?gÃ{ð}âº
have "?f_dotâM"
using cartprod_closed singleton_closed one_in_M
by simp
then
have "f â M[G]"
unfolding f_def
by (blast intro:GenExtI)
have "f = {val(P,G,opair_name(check(β),s`β,ð)) . βâα}"
unfolding f_def
using val_RepFun_one
by simp
also
have "... = {â¨Î²,val(P,G,s`β)â© . βâα}"
using val_opair_name valcheck generic one_in_G one_in_P
by simp
finally
have "f = {â¨Î²,val(P,G,s`β)â© . βâα}" .
then
have 1: "domain(f) = α" "function(f)"
unfolding function_def by auto
have 2: "y â a â¹ âxâα. f ` x = y" for y
proof -
fix y
assume
"y â a"
with â¹val(P,G,Ï) = aâº
obtain Ï where "Ïâdomain(Ï)" "val(P,G,Ï) = y"
using elem_of_val[of y _ Ï]
by blast
with â¹sâsurj(α,domain(Ï))âº
obtain β where "βâα" "s`β = Ï"
unfolding surj_def
by auto
with â¹val(P,G,Ï) = yâº
have "val(P,G,s`β) = y"
by simp
with â¹f = {â¨Î²,val(P,G,s`β)â© . βâα}⺠â¹Î²âαâº
have "â¨Î²,yâ©âf"
by auto
with â¹function(f)âº
have "f`β = y"
using function_apply_equality by simp
with â¹Î²âα⺠show
"âβâα. f ` β = y"
by auto
qed
then
have "âαâ(M[G]). âf'â(M[G]). Ord(α) â§ f' â surj(α,a)"
proof (cases "a=0")
case True
then
show ?thesis
unfolding surj_def
using zero_in_MG
by auto
next
case False
with â¹aâM[G]âº
obtain e where "eâa" "eâM[G]"
using transitivity_MG
by blast
with 1 and 2
have "induced_surj(f,a,e) â surj(α,a)"
using induced_surj_is_surj by simp
moreover from â¹fâM[G]⺠â¹aâM[G]⺠â¹eâM[G]âº
have "induced_surj(f,a,e) â M[G]"
unfolding induced_surj_def
by (simp flip: setclass_iff)
moreover
note â¹Î±âM[G]⺠â¹Ord(α)âº
ultimately
show ?thesis
by auto
qed
}
then
show ?thesis
using ext.choice_ax_abs
by simp
qed
end
sublocale G_generic1_AC â ext:M_ZC_basic "M[G]"
using choice_ax choice_in_MG
by unfold_locales
end>
Theory Internal_ZFC_Axioms
sectionâ¹The ZFC axioms, internalizedâº
theory Internal_ZFC_Axioms
imports
Forcing_Data
begin
schematic_goal ZF_union_auto:
"Union_ax(##A) ⷠ(A, [] ⨠?zfunion)"
unfolding Union_ax_def
by ((rule sep_rules | simp)+)
synthesize "ZF_union" from_schematic ZF_union_auto
notation ZF_union_fm (â¹â
Union Axâ
âº)
schematic_goal ZF_power_auto:
"power_ax(##A) ⷠ(A, [] ⨠?zfpow)"
unfolding power_ax_def powerset_def subset_def
by ((rule sep_rules | simp)+)
synthesize "ZF_power" from_schematic ZF_power_auto
notation ZF_power_fm (â¹â
Powerset Axâ
âº)
schematic_goal ZF_pairing_auto:
"upair_ax(##A) ⷠ(A, [] ⨠?zfpair)"
unfolding upair_ax_def
by ((rule sep_rules | simp)+)
synthesize "ZF_pairing" from_schematic ZF_pairing_auto
notation ZF_pairing_fm (â¹â
Pairingâ
âº)
schematic_goal ZF_foundation_auto:
"foundation_ax(##A) ⷠ(A, [] ⨠?zffound)"
unfolding foundation_ax_def
by ((rule sep_rules | simp)+)
synthesize "ZF_foundation" from_schematic ZF_foundation_auto
notation ZF_foundation_fm (â¹â
Foundationâ
âº)
schematic_goal ZF_extensionality_auto:
"extensionality(##A) ⷠ(A, [] ⨠?zfext)"
unfolding extensionality_def
by ((rule sep_rules | simp)+)
synthesize "ZF_extensionality" from_schematic ZF_extensionality_auto
notation ZF_extensionality_fm (â¹â
Extensionalityâ
âº)
schematic_goal ZF_infinity_auto:
"infinity_ax(##A) â· (A, [] ⨠(?Ï(i,j,h)))"
unfolding infinity_ax_def
by ((rule sep_rules | simp)+)
synthesize "ZF_infinity" from_schematic ZF_infinity_auto
notation ZF_infinity_fm (â¹â
Infinityâ
âº)
schematic_goal ZF_choice_auto:
"choice_ax(##A) â· (A, [] ⨠(?Ï(i,j,h)))"
unfolding choice_ax_def
by ((rule sep_rules | simp)+)
synthesize "ZF_choice" from_schematic ZF_choice_auto
notation ZF_choice_fm (â¹â
ACâ
âº)
lemmas ZFC_fm_defs = ZF_extensionality_fm_def ZF_foundation_fm_def ZF_pairing_fm_def
ZF_union_fm_def ZF_infinity_fm_def ZF_power_fm_def ZF_choice_fm_def
lemmas ZFC_fm_sats = ZF_extensionality_auto ZF_foundation_auto ZF_pairing_auto
ZF_union_auto ZF_infinity_auto ZF_power_auto ZF_choice_auto
definition
ZF_fin :: "i" where
"ZF_fin â¡ {â
Extensionalityâ
, â
Foundationâ
, â
Pairingâ
,
â
Union Axâ
, â
Infinityâ
, â
Powerset Axâ
}"
subsectionâ¹The Axiom of Separation, internalizedâº
lemma iterates_Forall_type [TC]:
"⦠n â nat; p â formula â§ â¹ Forall^n(p) â formula"
by (induct set:nat, auto)
lemma last_init_eq :
assumes "l â list(A)" "length(l) = succ(n)"
shows "â aâA. âl'âlist(A). l = l'@[a]"
proof-
from â¹lâ_⺠â¹length(_) = _âº
have "rev(l) â list(A)" "length(rev(l)) = succ(n)"
by simp_all
then
obtain a l' where "aâA" "l'âlist(A)" "rev(l) = Cons(a,l')"
by (cases;simp)
then
have "l = rev(l') @ [a]" "rev(l') â list(A)"
using rev_rev_ident[OF â¹lâ_âº] by auto
with â¹aâ_âº
show ?thesis by blast
qed
lemma take_drop_eq :
assumes "lâlist(M)"
shows "â n . n < succ(length(l)) â¹ l = take(n,l) @ drop(n,l)"
using â¹lâlist(M)âº
proof induct
case Nil
then show ?case by auto
next
case (Cons a l)
then show ?case
proof -
{
fix i
assume "i<succ(succ(length(l)))"
with â¹lâlist(M)âº
consider (lt) "i = 0" | (eq) "âkânat. i = succ(k) â§ k < succ(length(l))"
using â¹lâlist(M)⺠le_natI nat_imp_quasinat
by (cases rule:nat_cases[of i];auto)
then
have "take(i,Cons(a,l)) @ drop(i,Cons(a,l)) = Cons(a,l)"
using Cons
by (cases;auto)
}
then show ?thesis using Cons by auto
qed
qed
lemma list_split :
assumes "n ⤠succ(length(rest))" "rest â list(M)"
shows "âreâlist(M). âstâlist(M). rest = re @ st â§ length(re) = pred(n)"
proof -
from assms
have "pred(n) ⤠length(rest)"
using pred_mono[OF _ â¹nâ¤_âº] pred_succ_eq by auto
with â¹restâ_âº
have "pred(n)ânat" "rest = take(pred(n),rest) @ drop(pred(n),rest)" (is "_ = ?re @ ?st")
using take_drop_eq[OF â¹restâ_âº] le_natI by auto
then
have "length(?re) = pred(n)" "?reâlist(M)" "?stâlist(M)"
using length_take[rule_format,OF _ â¹pred(n)â_âº] â¹pred(n) ⤠_⺠â¹restâ_âº
unfolding min_def
by auto
then
show ?thesis
using rev_bexI[of _ _ "λ re. âstâlist(M). rest = re @ st â§ length(re) = pred(n)"]
â¹length(?re) = _⺠â¹rest = _âº
by auto
qed
lemma sats_nForall:
assumes
"Ï â formula"
shows
"nânat â¹ ms â list(M) â¹
(M, ms ⨠(Forall^n(Ï))) â·
(ârest â list(M). length(rest) = n â¶ M, rest @ ms ⨠Ï)"
proof (induct n arbitrary:ms set:nat)
case 0
with assms
show ?case by simp
next
case (succ n)
have "(ârestâlist(M). length(rest) = succ(n) â¶ P(rest,n)) â·
(âtâM. âresâlist(M). length(res) = n â¶ P(res @ [t],n))"
if "nânat" for n P
using that last_init_eq by force
from this[of _ "λrest _. (M, rest @ ms ⨠Ï)"] â¹nânatâº
have "(ârestâlist(M). length(rest) = succ(n) â¶ M, rest @ ms ⨠Ï) â·
(âtâM. âresâlist(M). length(res) = n â¶ M, (res @ [t]) @ ms ⨠Ï)"
by simp
with assms succ(1,3) succ(2)[of "Cons(_,ms)"]
show ?case
using arity_sats_iff[of Ï _ M "Cons(_, ms @ _)"] app_assoc
by (simp)
qed
definition
sep_body_fm :: "i â i" where
"sep_body_fm(p) â¡ (â
â(â
â(â
ââ
â
0 â 1â
â â
â
0 â 2â
â§ incr_bv1^2 (p) â
â
â
)â
)â
)"
lemma sep_body_fm_type [TC]: "p â formula â¹ sep_body_fm(p) â formula"
by (simp add: sep_body_fm_def)
lemma sats_sep_body_fm:
assumes
"Ï â formula" "msâlist(M)" "restâlist(M)"
shows
"(M, rest @ ms ⨠sep_body_fm(Ï)) â·
separation(##M,λx. M, [x] @ rest @ ms ⨠Ï)"
using assms formula_add_params1[of _ 2 _ _ "[_,_]" ]
unfolding sep_body_fm_def separation_def by simp
definition
ZF_separation_fm :: "i â i" (â¹â
Separation'(_')â
âº) where
"ZF_separation_fm(p) â¡ Forall^(pred(arity(p)))(sep_body_fm(p))"
lemma ZF_separation_fm_type [TC]: "p â formula â¹ ZF_separation_fm(p) â formula"
by (simp add: ZF_separation_fm_def)
lemma sats_ZF_separation_fm_iff:
assumes
"Ïâformula"
shows
"(M, [] ⨠â
Separation(Ï)â
)
â·
(âenvâlist(M). arity(Ï) ⤠1 +â©Ï length(env) â¶
separation(##M,λx. M, [x] @ env ⨠Ï))"
proof (intro iffI ballI impI)
let ?n="pred(arity(Ï))"
fix env
assume "M, [] ⨠ZF_separation_fm(Ï)"
assume "arity(Ï) ⤠1 +â©Ï length(env)" "envâlist(M)"
moreover from this
have "arity(Ï) ⤠succ(length(env))" by simp
then
obtain some rest where "someâlist(M)" "restâlist(M)"
"env = some @ rest" "length(some) = pred(arity(Ï))"
using list_split[OF â¹arity(Ï) ⤠succ(_)⺠â¹envâ_âº] by force
moreover from â¹Ïâ_âº
have "arity(Ï) ⤠succ(pred(arity(Ï)))"
using succpred_leI by simp
moreover
note assms
moreover
assume "M, [] ⨠ZF_separation_fm(Ï)"
moreover from calculation
have "M, some ⨠sep_body_fm(Ï)"
using sats_nForall[of "sep_body_fm(Ï)" ?n]
unfolding ZF_separation_fm_def by simp
ultimately
show "separation(##M, λx. M, [x] @ env ⨠Ï)"
unfolding ZF_separation_fm_def
using sats_sep_body_fm[of Ï "[]" M some]
arity_sats_iff[of Ï rest M "[_] @ some"]
separation_cong[of "##M" "λx. M, Cons(x, some @ rest) ⨠Ï" _ ]
by simp
next
let ?n="pred(arity(Ï))"
assume asm:"âenvâlist(M). arity(Ï) ⤠1 +â©Ï length(env) â¶
separation(##M, λx. M, [x] @ env ⨠Ï)"
{
fix some
assume "someâlist(M)" "length(some) = pred(arity(Ï))"
moreover
note â¹Ïâ_âº
moreover from calculation
have "arity(Ï) ⤠1 +â©Ï length(some)"
using le_trans[OF succpred_leI] succpred_leI by simp
moreover from calculation and asm
have "separation(##M, λx. M, [x] @ some ⨠Ï)" by blast
ultimately
have "M, some ⨠sep_body_fm(Ï)"
using sats_sep_body_fm[of Ï "[]" M some]
arity_sats_iff[of Ï _ M "[_,_] @ some"]
strong_replacement_cong[of "##M" "λx y. M, Cons(x, Cons(y, some @ _)) ⨠Ï" _ ]
by simp
}
with â¹Ïâ_âº
show "M, [] ⨠ZF_separation_fm(Ï)"
using sats_nForall[of "sep_body_fm(Ï)" ?n]
unfolding ZF_separation_fm_def
by simp
qed
subsectionâ¹The Axiom of Replacement, internalizedâº
schematic_goal sats_univalent_fm_auto:
assumes
Q_iff_sats:"âx y z. x â A â¹ y â A â¹ zâA â¹
Q(x,z) ⷠ(A,Cons(z,Cons(y,Cons(x,env))) ⨠Q1_fm)"
"âx y z. x â A â¹ y â A â¹ zâA â¹
Q(x,y) ⷠ(A,Cons(z,Cons(y,Cons(x,env))) ⨠Q2_fm)"
and
asms: "nth(i,env) = B" "i â nat" "env â list(A)"
shows
"univalent(##A,B,Q) ⷠA,env ⨠?ufm(i)"
unfolding univalent_def
by (insert asms; (rule sep_rules Q_iff_sats | simp)+)
synthesize_notc "univalent" from_schematic sats_univalent_fm_auto
lemma univalent_fm_type [TC]: "q1â formula â¹ q2âformula â¹ iânat â¹
univalent_fm(q2,q1,i) âformula"
by (simp add:univalent_fm_def)
lemma sats_univalent_fm :
assumes
Q_iff_sats:"âx y z. x â A â¹ y â A â¹ zâA â¹
Q(x,z) ⷠ(A,Cons(z,Cons(y,Cons(x,env))) ⨠Q1_fm)"
"âx y z. x â A â¹ y â A â¹ zâA â¹
Q(x,y) ⷠ(A,Cons(z,Cons(y,Cons(x,env))) ⨠Q2_fm)"
and
asms: "nth(i,env) = B" "i â nat" "env â list(A)"
shows
"(A,env ⨠univalent_fm(Q1_fm,Q2_fm,i)) ⷠunivalent(##A,B,Q)"
unfolding univalent_fm_def using asms sats_univalent_fm_auto[OF Q_iff_sats] by simp
definition
swap_vars :: "iâi" where
"swap_vars(Ï) â¡
Exists(Exists(And(Equal(0,3),And(Equal(1,2),iterates(λp. incr_bv(p)`2 , 2, Ï)))))"
lemma swap_vars_type[TC] :
"Ïâformula â¹ swap_vars(Ï) âformula"
unfolding swap_vars_def by simp
lemma sats_swap_vars :
"[x,y] @ env â list(M) â¹ Ïâformula â¹
(M, [x,y] @ env ⨠swap_vars(Ï)) â· M,[y,x] @ env ⨠Ï"
unfolding swap_vars_def
using sats_incr_bv_iff [of _ _ M _ "[y,x]"] by simp
definition
univalent_Q1 :: "i â i" where
"univalent_Q1(Ï) â¡ incr_bv1(swap_vars(Ï))"
definition
univalent_Q2 :: "i â i" where
"univalent_Q2(Ï) â¡ incr_bv(swap_vars(Ï))`0"
lemma univalent_Qs_type [TC]:
assumes "Ïâformula"
shows "univalent_Q1(Ï) â formula" "univalent_Q2(Ï) â formula"
unfolding univalent_Q1_def univalent_Q2_def using assms by simp_all
lemma sats_univalent_fm_assm:
assumes
"x â A" "y â A" "zâA" "envâ list(A)" "Ï â formula"
shows
"(A, ([x,z] @ env) ⨠Ï) â· (A, Cons(z,Cons(y,Cons(x,env))) ⨠(univalent_Q1(Ï)))"
"(A, ([x,y] @ env) ⨠Ï) â· (A, Cons(z,Cons(y,Cons(x,env))) ⨠(univalent_Q2(Ï)))"
unfolding univalent_Q1_def univalent_Q2_def
using
sats_incr_bv_iff[of _ _ A _ "[]"]
sats_incr_bv1_iff[of _ "Cons(x,env)" A z y]
sats_swap_vars assms
by simp_all
definition
rep_body_fm :: "i â i" where
"rep_body_fm(p) â¡ Forall(Implies(
univalent_fm(univalent_Q1(incr_bv(p)`2),univalent_Q2(incr_bv(p)`2),0),
Exists(Forall(
Iff(Member(0,1),Exists(And(Member(0,3),incr_bv(incr_bv(p)`2)`2)))))))"
lemma rep_body_fm_type [TC]: "p â formula â¹ rep_body_fm(p) â formula"
by (simp add: rep_body_fm_def)
lemmas ZF_replacement_simps = formula_add_params1[of Ï 2 _ M "[_,_]" ]
sats_incr_bv_iff[of _ _ M _ "[]"]
sats_incr_bv_iff[of _ _ M _ "[_,_]"]
sats_incr_bv1_iff[of _ _ M] sats_swap_vars for Ï M
lemma sats_rep_body_fm:
assumes
"Ï â formula" "msâlist(M)" "restâlist(M)"
shows
"(M, rest @ ms ⨠rep_body_fm(Ï)) â·
strong_replacement(##M,λx y. M, [x,y] @ rest @ ms ⨠Ï)"
using assms ZF_replacement_simps
unfolding rep_body_fm_def strong_replacement_def univalent_def
unfolding univalent_fm_def univalent_Q1_def univalent_Q2_def
by simp
definition
ZF_replacement_fm :: "i â i" (â¹â
Replacement'(_')â
âº) where
"ZF_replacement_fm(p) â¡ Forall^(pred(pred(arity(p))))(rep_body_fm(p))"
lemma ZF_replacement_fm_type [TC]: "p â formula â¹ ZF_replacement_fm(p) â formula"
by (simp add: ZF_replacement_fm_def)
lemma sats_ZF_replacement_fm_iff:
assumes
"Ïâformula"
shows
"(M, [] ⨠â
Replacement(Ï)â
)
â·
(âenvâlist(M). arity(Ï) ⤠2 +â©Ï length(env) â¶
strong_replacement(##M,λx y. M,[x,y] @ env ⨠Ï))"
proof (intro iffI ballI impI)
let ?n="pred(pred(arity(Ï)))"
fix env
assume "M, [] ⨠ZF_replacement_fm(Ï)" "arity(Ï) ⤠2 +â©Ï length(env)" "envâlist(M)"
moreover from this
have "arity(Ï) ⤠succ(succ(length(env)))" by (simp)
moreover from calculation
have "pred(arity(Ï)) ⤠succ(length(env))"
using pred_mono[OF _ â¹arity(Ï)â¤succ(_)âº] pred_succ_eq by simp
moreover from calculation
obtain some rest where "someâlist(M)" "restâlist(M)"
"env = some @ rest" "length(some) = pred(pred(arity(Ï)))"
using list_split[OF â¹pred(_) ⤠_⺠â¹envâ_âº] by auto
moreover
note â¹Ïâ_âº
moreover from this
have "arity(Ï) ⤠succ(succ(pred(pred(arity(Ï)))))"
using le_trans[OF succpred_leI] succpred_leI by simp
moreover from calculation
have "M, some ⨠rep_body_fm(Ï)"
using sats_nForall[of "rep_body_fm(Ï)" ?n]
unfolding ZF_replacement_fm_def
by simp
ultimately
show "strong_replacement(##M, λx y. M, [x, y] @ env ⨠Ï)"
using sats_rep_body_fm[of Ï "[]" M some]
arity_sats_iff[of Ï rest M "[_,_] @ some"]
strong_replacement_cong[of "##M" "λx y. M, Cons(x, Cons(y, some @ rest)) ⨠Ï" _ ]
by simp
next
let ?n="pred(pred(arity(Ï)))"
assume asm:"âenvâlist(M). arity(Ï) ⤠2 +â©Ï length(env) â¶
strong_replacement(##M, λx y. M, [x, y] @ env ⨠Ï)"
{
fix some
assume "someâlist(M)" "length(some) = pred(pred(arity(Ï)))"
moreover
note â¹Ïâ_âº
moreover from calculation
have "arity(Ï) ⤠2 +â©Ï length(some)"
using le_trans[OF succpred_leI] succpred_leI by simp
moreover from calculation and asm
have "strong_replacement(##M, λx y. M, [x, y] @ some ⨠Ï)" by blast
ultimately
have "M, some ⨠rep_body_fm(Ï)"
using sats_rep_body_fm[of Ï "[]" M some]
arity_sats_iff[of Ï _ M "[_,_] @ some"]
strong_replacement_cong[of "##M" "λx y. M, Cons(x, Cons(y, some @ _)) ⨠Ï" _ ]
by simp
}
with â¹Ïâ_âº
show "M, [] ⨠ZF_replacement_fm(Ï)"
using sats_nForall[of "rep_body_fm(Ï)" ?n]
unfolding ZF_replacement_fm_def
by simp
qed
definition
ZF_schemes :: "i" where
"ZF_schemes â¡ {â
Separation(p)â
. p â formula } ⪠{â
Replacement(p)â
. p â formula }"
lemma Un_subset_formula [TC]: "Aâformula â§ Bâformula â¹ AâªB â formula"
by auto
lemma ZF_schemes_subset_formula [TC]: "ZF_schemes â formula"
unfolding ZF_schemes_def by auto
lemma ZF_fin_subset_formula [TC]: "ZF_fin â formula"
unfolding ZF_fin_def by simp
definition
ZF :: "i" where
"ZF ⡠ZF_schemes ⪠ZF_fin"
lemma ZF_subset_formula [TC]: "ZF â formula"
unfolding ZF_def by auto
definition
ZFC :: "i" where
"ZFC â¡ ZF ⪠{â
ACâ
}"
definition
ZF_minus_P :: "i" where
"ZF_minus_P â¡ ZF - { â
Powerset Axâ
}"
definition
Zermelo_fms :: "i" (â¹â
Zâ
âº) where
"Zermelo_fms â¡ ZF_fin ⪠{â
Separation(p)â
. p â formula }"
definition
ZC :: "i" where
"ZC â¡ Zermelo_fms ⪠{â
ACâ
}"
lemma ZFC_subset_formula: "ZFC â formula"
by (simp add:ZFC_def Un_subset_formula)
txtâ¹Satisfaction of a set of sentencesâº
definition
satT :: "[i,i] â o" ("_ ⨠_" [36,36] 60) where
"A ⨠Φ â¡ âÏâΦ. (A,[] ⨠Ï)"
lemma satTI [intro!]:
assumes "âÏ. ÏâΦ â¹ A,[] ⨠Ï"
shows "A ⨠Φ"
using assms unfolding satT_def by simp
lemma satTD [dest] :"A ⨠Φ â¹ ÏâΦ â¹ A,[] ⨠Ï"
unfolding satT_def by simp
lemma satT_mono: "A ⨠Φ ⹠Ψ â Φ â¹ A ⨠Ψ"
by blast
lemma satT_Un_iff: "M ⨠Φ ⪠Ψ ⷠM ⨠Φ ⧠M ⨠Ψ" by auto
lemma sats_ZFC_iff_sats_ZF_AC:
"(N ⨠ZFC) â· (N ⨠ZF) â§ (N, [] ⨠â
ACâ
)"
unfolding ZFC_def ZF_def by auto
lemma satT_ZF_imp_satT_Z: "M ⨠ZF â¹ M ⨠â
Zâ
"
unfolding ZF_def ZF_schemes_def Zermelo_fms_def ZF_fin_def by auto
lemma satT_ZFC_imp_satT_ZC: "M ⨠ZFC ⹠M ⨠ZC"
unfolding ZFC_def ZF_def ZF_schemes_def ZC_def Zermelo_fms_def by auto
lemma satT_Z_ZF_replacement_imp_satT_ZF: "N ⨠â
Zâ
â¹ N ⨠{â
Replacement(x)â
. x â formula} â¹ N ⨠ZF"
unfolding ZF_def ZF_schemes_def Zermelo_fms_def ZF_fin_def by auto
lemma satT_ZC_ZF_replacement_imp_satT_ZFC: "N ⨠ZC â¹ N ⨠{â
Replacement(x)â
. x â formula} â¹ N ⨠ZFC"
unfolding ZFC_def ZF_def ZF_schemes_def ZC_def Zermelo_fms_def by auto
lemma ground_repl_fm_sub_ZF: "{â
Replacement(ground_repl_fm(Ï))â
. Ï â formula} â ZF"
unfolding ZF_def ZF_schemes_def by auto
lemma ZF_replacement_fms_sub_ZFC: "{â
Replacement(Ï)â
. Ï â formula} â ZFC"
unfolding ZFC_def ZF_def ZF_schemes_def by auto
lemma ground_repl_fm_sub_ZFC: "{â
Replacement(ground_repl_fm(Ï))â
. Ï â formula} â ZFC"
unfolding ZFC_def ZF_def ZF_schemes_def by auto
lemma ZF_replacement_ground_repl_fm_type: "{â
Replacement(ground_repl_fm(Ï))â
. Ï â formula} â formula"
by auto
end
d>
Theory Separation_Instances
subsectionâ¹More Instances of Separationâº
theory Separation_Instances
imports
Names
begin
textâ¹The following instances are mostly the same repetitive task; and we just
copied and pasted, tweaking some lemmas if needed (for example, we might have
needed to use some closedness results).
âº
definition radd_body :: "[i,i,i] â o" where
"radd_body(R,S) ⡠λz. (âx y. z = â¨Inl(x), Inr(y)â©) â¨
(âx' x. z = â¨Inl(x'), Inl(x)â© â§ â¨x', xâ© â R) â¨
(ây' y. z = â¨Inr(y'), Inr(y)â© â§ â¨y', yâ© â S)"
relativize functional "radd_body" "radd_body_rel"
relationalize "radd_body_rel" "is_radd_body"
synthesize "is_radd_body" from_definition
arity_theorem for "is_radd_body_fm"
lemma (in M_ZF1_trans) radd_body_abs:
assumes "(##M)(R)" "(##M)(S)" "(##M)(x)"
shows "is_radd_body(##M,R,S,x) â· radd_body(R,S,x)"
using assms pair_in_M_iff Inl_in_M_iff Inr_in_M_iff
unfolding radd_body_def is_radd_body_def
by (auto)
lemma (in M_ZF1_trans) separation_radd_body:
"(##M)(R) â¹ (##M)(S) â¹ separation
(##M, λz. (âx y. z = â¨Inl(x), Inr(y)â©) â¨
(âx' x. z = â¨Inl(x'), Inl(x)â© â§ â¨x', xâ© â R) â¨
(ây' y. z = â¨Inr(y'), Inr(y)â© â§ â¨y', yâ© â S))"
using separation_in_ctm[where Ï="is_radd_body_fm(1,2,0)" and env="[R,S]"]
is_radd_body_def arity_is_radd_body_fm ord_simp_union is_radd_body_fm_type radd_body_abs
unfolding radd_body_def
by simp
definition rmult_body :: "[i,i,i] â o" where
"rmult_body(b,d) ⡠λz. âx' y' x y. z = â¨â¨x', y'â©, x, yâ© â§ (â¨x', xâ© â
b ⨠x' = x â§ â¨y', yâ© â d)"
relativize functional "rmult_body" "rmult_body_rel"
relationalize "rmult_body_rel" "is_rmult_body"
synthesize "is_rmult_body" from_definition
arity_theorem for "is_rmult_body_fm"
lemma (in M_ZF1_trans) rmult_body_abs:
assumes "(##M)(b)" "(##M)(d)" "(##M)(x)"
shows "is_rmult_body(##M,b,d,x) â· rmult_body(b,d,x)"
using assms pair_in_M_iff apply_closed
unfolding rmult_body_def is_rmult_body_def
by (auto)
lemma (in M_ZF1_trans) separation_rmult_body:
"(##M)(b) â¹ (##M)(d) â¹ separation
(##M, λz. âx' y' x y. z = â¨â¨x', y'â©, x, yâ© â§ (â¨x', xâ© â b ⨠x' = x â§ â¨y', yâ© â d))"
using separation_in_ctm[where Ï="is_rmult_body_fm(1,2,0)" and env="[b,d]"]
is_rmult_body_def arity_is_rmult_body_fm ord_simp_union is_rmult_body_fm_type rmult_body_abs
unfolding rmult_body_def
by simp
lemma (in M_replacement) separation_well_ord:
"(M)(f) â¹ (M)(r) â¹ (M)(A) â¹ separation
(M, λx. x â A â¶ (ây[M]. âp[M]. is_apply(M, f, x, y) â§ pair(M, y, x, p) â§ p â r))"
using separation_imp separation_in lam_replacement_identity lam_replacement_constant
lam_replacement_apply[of f] lam_replacement_Pair[THEN [5] lam_replacement_hcomp2]
by simp
definition is_obase_body :: "[iâo,i,i,i] â o" where
"is_obase_body(N,A,r,x) â¡ x â A â¶
¬ (ây[N].
âg[N].
ordinal(N, y) â§
(âmy[N].
âpxr[N].
membership(N, y, my) â§
pred_set(N, A, x, r, pxr) â§
order_isomorphism(N, pxr, r, y, my, g)))"
synthesize "is_obase_body" from_definition
arity_theorem for "is_obase_body_fm"
lemma (in M_ZF1_trans) separation_is_obase:
"(##M)(f) â¹ (##M)(r) â¹ (##M)(A) â¹ separation
(##M, λx. x â A â¶
¬ (ây[##M].
âg[##M].
ordinal(##M, y) â§
(âmy[##M].
âpxr[##M].
membership(##M, y, my) â§
pred_set(##M, A, x, r, pxr) â§
order_isomorphism(##M, pxr, r, y, my, g))))"
using separation_in_ctm[where Ï="is_obase_body_fm(1,2,0)" and env="[A,r]"]
is_obase_body_def arity_is_obase_body_fm ord_simp_union is_obase_body_fm_type
by simp
definition is_obase_equals :: "[iâo,i,i,i] â o" where
"is_obase_equals(N,A,r,a) â¡ âx[N].
âg[N].
âmx[N].
âpar[N].
ordinal(N, x) â§
membership(N, x, mx) â§
pred_set(N, A, a, r, par) â§ order_isomorphism(N, par, r, x, mx, g)"
synthesize "is_obase_equals" from_definition
arity_theorem for "is_obase_equals_fm"
lemma (in M_ZF1_trans) separation_obase_equals:
"(##M)(f) â¹ (##M)(r) â¹ (##M)(A) â¹ separation
(##M, λa. âx[##M].
âg[##M].
âmx[##M].
âpar[##M].
ordinal(##M, x) â§
membership(##M, x, mx) â§
pred_set(##M, A, a, r, par) â§ order_isomorphism(##M, par, r, x, mx, g))"
using separation_in_ctm[where Ï="is_obase_equals_fm(1,2,0)" and env="[A,r]"]
is_obase_equals_def arity_is_obase_equals_fm ord_simp_union is_obase_equals_fm_type
by simp
synthesize "PiP_rel" from_definition assuming "nonempty"
arity_theorem for "PiP_rel_fm"
lemma (in M_ZF1_trans) separation_PiP_rel:
"(##M)(A) â¹ separation(##M, PiP_rel(##M,A))"
using separation_in_ctm[where env="[A]" and Ï="PiP_rel_fm(1,0)"]
nonempty PiP_rel_iff_sats[symmetric] arity_PiP_rel_fm PiP_rel_fm_type
by(simp_all add: ord_simp_union)
synthesize "injP_rel" from_definition assuming "nonempty"
arity_theorem for "injP_rel_fm"
lemma (in M_ZF1_trans) separation_injP_rel:
"(##M)(A) â¹ separation(##M, injP_rel(##M,A))"
using separation_in_ctm[where env="[A]" and Ï="injP_rel_fm(1,0)"]
nonempty injP_rel_iff_sats[symmetric] arity_injP_rel_fm injP_rel_fm_type
by(simp_all add: ord_simp_union)
synthesize "surjP_rel" from_definition assuming "nonempty"
arity_theorem for "surjP_rel_fm"
lemma (in M_ZF1_trans) separation_surjP_rel:
"(##M)(A) â¹ (##M)(B) â¹ separation(##M, surjP_rel(##M,A,B))"
using separation_in_ctm[where env="[A,B]" and Ï="surjP_rel_fm(1,2,0)"]
nonempty surjP_rel_iff_sats[symmetric] arity_surjP_rel_fm surjP_rel_fm_type
by(simp_all add: ord_simp_union)
synthesize "cons_like_rel" from_definition assuming "nonempty"
arity_theorem for "cons_like_rel_fm"
lemma (in M_ZF1_trans) separation_cons_like_rel:
"separation(##M, cons_like_rel(##M))"
using separation_in_ctm[where env="[]" and Ï="cons_like_rel_fm(0)"]
nonempty cons_like_rel_iff_sats[symmetric] arity_cons_like_rel_fm cons_like_rel_fm_type
by simp
lemma (in M_ZF1_trans) separation_is_function:
"separation(##M, is_function(##M))"
using separation_in_ctm[where env="[]" and Ï="function_fm(0)"] arity_function_fm
by simp
definition fstsnd_in_sndsnd :: "[i] â o" where
"fstsnd_in_sndsnd ⡠λx. fst(snd(x)) â snd(snd(x))"
relativize "fstsnd_in_sndsnd" "is_fstsnd_in_sndsnd"
synthesize "is_fstsnd_in_sndsnd" from_definition assuming "nonempty"
arity_theorem for "is_fstsnd_in_sndsnd_fm"
lemma (in M_ZF1_trans) fstsnd_in_sndsnd_abs:
assumes "(##M)(x)"
shows "is_fstsnd_in_sndsnd(##M,x) â· fstsnd_in_sndsnd(x)"
using assms pair_in_M_iff fst_abs snd_abs fst_snd_closed
unfolding fstsnd_in_sndsnd_def is_fstsnd_in_sndsnd_def
by auto
lemma (in M_ZF1_trans) separation_fstsnd_in_sndsnd:
"separation(##M, λx. fst(snd(x)) â snd(snd(x)))"
using separation_in_ctm[where env="[]" and Ï="is_fstsnd_in_sndsnd_fm(0)" and Q=fstsnd_in_sndsnd]
nonempty fstsnd_in_sndsnd_abs arity_is_fstsnd_in_sndsnd_fm
unfolding fstsnd_in_sndsnd_def
by simp
definition sndfst_eq_fstsnd :: "[i] â o" where
"sndfst_eq_fstsnd ⡠λx. snd(fst(x)) = fst(snd(x))"
relativize "sndfst_eq_fstsnd" "is_sndfst_eq_fstsnd"
synthesize "is_sndfst_eq_fstsnd" from_definition assuming "nonempty"
arity_theorem for "is_sndfst_eq_fstsnd_fm"
lemma (in M_ZF1_trans) sndfst_eq_fstsnd_abs:
assumes "(##M)(x)"
shows "is_sndfst_eq_fstsnd(##M,x) â· sndfst_eq_fstsnd(x)"
using assms pair_in_M_iff fst_abs snd_abs fst_snd_closed
unfolding sndfst_eq_fstsnd_def is_sndfst_eq_fstsnd_def
by auto
lemma (in M_ZF1_trans) separation_sndfst_eq_fstsnd:
"separation(##M, λx. snd(fst(x)) = fst(snd(x)))"
using separation_in_ctm[where env="[]" and Ï="is_sndfst_eq_fstsnd_fm(0)" and Q=sndfst_eq_fstsnd]
nonempty sndfst_eq_fstsnd_abs arity_is_sndfst_eq_fstsnd_fm
unfolding sndfst_eq_fstsnd_def
by simp
definition insnd_ballPair :: "[i,i,i] â o" where
"insnd_ballPair(B,A) ⡠λp. âxâB. x â snd(p) â· (âsâfst(p). â¨s, xâ© â A)"
relativize "insnd_ballPair" "is_insnd_ballPair"
synthesize "is_insnd_ballPair" from_definition assuming "nonempty"
arity_theorem for "is_insnd_ballPair_fm"
lemma (in M_ZF1_trans) insnd_ballPair_abs:
assumes "(##M)(B)" "(##M)(A)" "(##M)(x)"
shows "is_insnd_ballPair(##M,B,A,x) â· insnd_ballPair(B,A,x)"
using assms pair_in_M_iff fst_abs snd_abs fst_snd_closed
transM[of _ B] transM[of _ "snd(x)"] transM[of _ "fst(x)"]
unfolding insnd_ballPair_def is_insnd_ballPair_def
by (auto)
lemma (in M_ZF1_trans) separation_insnd_ballPair:
"(##M)(B) â¹ (##M)(A) â¹ separation(##M, λp. âxâB. x â snd(p) â· (âsâfst(p). â¨s, xâ© â A))"
using insnd_ballPair_abs nonempty
separation_in_ctm[where Ï="is_insnd_ballPair_fm(2,1,0)" and env="[A,B]"]
arity_is_insnd_ballPair_fm ord_simp_union is_insnd_ballPair_fm_type
unfolding insnd_ballPair_def
by simp
endad>
Theory Replacement_Instances
sectionâ¹More Instances of Replacementâº
theory Replacement_Instances
imports
Separation_Instances
Transitive_Models.Pointed_DC_Relative
begin
synthesize "setdiff" from_definition "setdiff" assuming "nonempty"
arity_theorem for "setdiff_fm"
relationalize "first_rel" "is_first" external
synthesize "first_fm" from_definition "is_first" assuming "nonempty"
relationalize "minimum_rel" "is_minimum" external
definition is_minimum' where
"is_minimum'(M,R,X,u) â¡ (M(u) â§ u â X â§ (âv[M]. âa[M]. (v â X â¶ v â u â¶ a â R) â§ pair(M, u, v, a))) â§
(âx[M].
(M(x) â§ x â X â§ (âv[M]. âa[M]. (v â X â¶ v â x â¶ a â R) â§ pair(M, x, v, a))) â§
(ây[M]. M(y) â§ y â X â§ (âv[M]. âa[M]. (v â X â¶ v â y â¶ a â R) â§ pair(M, y, v, a)) â¶ y = x)) â¨
¬ (âx[M]. (M(x) â§ x â X â§ (âv[M]. âa[M]. (v â X â¶ v â x â¶ a â R) â§ pair(M, x, v, a))) â§
(ây[M]. M(y) â§ y â X â§ (âv[M]. âa[M]. (v â X â¶ v â y â¶ a â R) â§ pair(M, y, v, a)) â¶ y = x)) â§
empty(M, u)"
synthesize "minimum" from_definition "is_minimum'" assuming "nonempty"
arity_theorem for "minimum_fm"
lemma composition_fm_type[TC]: "a0 â Ï â¹ a1 â Ï â¹ a2 â Ï â¹
composition_fm(a0,a1,a2) â formula"
unfolding composition_fm_def by simp
arity_theorem for "composition_fm"
definition is_omega_funspace :: "[iâo,i,i,i]âo" where
"is_omega_funspace(N,B,n,z) â¡ âo[N]. omega(N,o) â§ nâo â§ is_funspace(N, n, B, z)"
synthesize "omega_funspace" from_definition "is_omega_funspace" assuming "nonempty"
arity_theorem for "omega_funspace_fm"
definition HAleph_wfrec_repl_body where
"HAleph_wfrec_repl_body(N,mesa,x,z) â¡ ây[N].
pair(N, x, y, z) â§
(âf[N].
(âz[N].
z â f â·
(âxa[N].
ây[N].
âxaa[N].
âsx[N].
âr_sx[N].
âf_r_sx[N].
pair(N, xa, y, z) â§
pair(N, xa, x, xaa) â§
upair(N, xa, xa, sx) â§
pre_image(N, mesa, sx, r_sx) â§ restriction(N, f, r_sx, f_r_sx) â§ xaa â mesa â§ is_HAleph(N, xa, f_r_sx, y))) â§
is_HAleph(N, x, f, y))"
arity_theorem for "ordinal_fm"
arity_theorem for "is_Limit_fm"
arity_theorem for "empty_fm"
arity_theorem for "fun_apply_fm"
synthesize "HAleph_wfrec_repl_body" from_definition assuming "nonempty"
arity_theorem for "HAleph_wfrec_repl_body_fm"
definition dcwit_repl_body where
"dcwit_repl_body(N,mesa,A,a,s,R) ⡠λx z. ây[N]. pair(N, x, y, z) â§
is_wfrec
(N, λn f. is_nat_case
(N, a,
λm bmfm.
âfm[N].
âcp[N].
is_apply(N, f, m, fm) â§
is_Collect(N, A, λx. âfmx[N]. (N(x) â§ fmx â R) â§ pair(N, fm, x, fmx), cp) â§
is_apply(N, s, cp, bmfm),
n),
mesa, x, y)"
manual_schematic for "dcwit_repl_body" assuming "nonempty"
unfolding dcwit_repl_body_def
by (rule iff_sats is_nat_case_iff_sats is_eclose_iff_sats sep_rules | simp)+
synthesize "dcwit_repl_body" from_schematic
definition dcwit_aux_fm where
"dcwit_aux_fm(A,s,R) â¡ (â
ââ
â
4`2 is 0â
â§
(â
ââ
Collect_fm
(succ(succ(succ(succ(succ(succ(succ(succ(succ(succ(A)))))))))),
(â
ââ
â
0 â
succ(succ(succ(succ(succ(succ(succ(succ(succ(succ(succ(succ(R)))))))))))) â
â§
pair_fm(3, 1, 0) â
â
),
0) â§
â
succ(succ(succ(succ(succ(succ(succ(succ(succ(succ(s))))))))))`0 is 2â
â
â
)â
â
)"
arity_theorem for "dcwit_aux_fm"
lemma dcwit_aux_fm_type[TC]: "A â Ï â¹ s â Ï â¹ R â Ï â¹ dcwit_aux_fm(A,s,R) â formula"
by (simp_all add: dcwit_aux_fm_def)
definition is_nat_case_dcwit_aux_fm where
"is_nat_case_dcwit_aux_fm(A,a,s,R) â¡ is_nat_case_fm
(succ(succ(succ(succ(succ(succ(a)))))),dcwit_aux_fm(A,s,R),
2, 0)"
lemma is_nat_case_dcwit_aux_fm_type[TC]: "A â Ï â¹ a â Ï â¹ s â Ï â¹ R â Ï â¹ is_nat_case_dcwit_aux_fm(A,a,s,R) â formula"
by (simp_all add: is_nat_case_dcwit_aux_fm_def)
manual_arity for "is_nat_case_dcwit_aux_fm"
unfolding is_nat_case_dcwit_aux_fm_def
by (rule arity_dcwit_aux_fm[THEN [6] arity_is_nat_case_fm]) simp_all
manual_arity for "dcwit_repl_body_fm"
using arity_is_nat_case_dcwit_aux_fm[THEN [6] arity_is_wfrec_fm]
unfolding dcwit_repl_body_fm_def is_nat_case_dcwit_aux_fm_def dcwit_aux_fm_def
by (auto simp add: arity(1-33))
lemma arity_dcwit_repl_body: "arity(dcwit_repl_body_fm(6,5,4,3,2,0,1)) = 7"
by (simp_all add: FOL_arities arity_dcwit_repl_body_fm ord_simp_union)
definition fst2_snd2
where "fst2_snd2(x) â¡ â¨fst(fst(x)), snd(snd(x))â©"
relativize functional "fst2_snd2" "fst2_snd2_rel"
relationalize "fst2_snd2_rel" "is_fst2_snd2"
lemma (in M_trivial) fst2_snd2_abs:
assumes "M(x)" "M(res)"
shows "is_fst2_snd2(M, x, res) â· res = fst2_snd2(x)"
unfolding is_fst2_snd2_def fst2_snd2_def
using fst_rel_abs[symmetric] snd_rel_abs[symmetric] fst_abs snd_abs assms
by simp
synthesize "is_fst2_snd2" from_definition assuming "nonempty"
arity_theorem for "is_fst2_snd2_fm"
definition sndfst_fst2_snd2
where "sndfst_fst2_snd2(x) â¡ â¨snd(fst(x)), fst(fst(x)), snd(snd(x))â©"
relativize functional "sndfst_fst2_snd2" "sndfst_fst2_snd2_rel"
relationalize "sndfst_fst2_snd2_rel" "is_sndfst_fst2_snd2"
synthesize "is_sndfst_fst2_snd2" from_definition assuming "nonempty"
arity_theorem for "is_sndfst_fst2_snd2_fm"
definition RepFun_body :: "i â i â i"where
"RepFun_body(u,v) â¡ {{â¨v, xâ©} . x â u}"
relativize functional "RepFun_body" "RepFun_body_rel"
relationalize "RepFun_body_rel" "is_RepFun_body"
synthesize "is_RepFun_body" from_definition assuming "nonempty"
arity_theorem for "is_RepFun_body_fm"
lemma arity_body_repfun:
"arity((â
ââ
cons_fm(0, 3, 2) â§ pair_fm(5, 1, 0) â
â
)) = 5"
using arity_cons_fm arity_pair_fm pred_Un_distrib union_abs1 FOL_arities
by auto
lemma arity_RepFun: "arity(is_RepFun_body_fm(0, 1, 2)) = 3"
unfolding is_RepFun_body_fm_def
using arity_Replace_fm[OF _ _ _ _ arity_body_repfun] arity_fst_fm arity_snd_fm arity_empty_fm
pred_Un_distrib union_abs2 union_abs1 FOL_arities
by simp
definition order_eq_map where
"order_eq_map(M,A,r,a,z) â¡ âx[M]. âg[M]. âmx[M]. âpar[M].
ordinal(M,x) & pair(M,a,x,z) & membership(M,x,mx) &
pred_set(M,A,a,r,par) & order_isomorphism(M,par,r,x,mx,g)"
synthesize "order_eq_map" from_definition assuming "nonempty"
arity_theorem for "is_ord_iso_fm"
arity_theorem for "order_eq_map_fm"
synthesize "is_banach_functor" from_definition assuming "nonempty"
arity_theorem for "is_banach_functor_fm"
definition banach_body_iterates where
"banach_body_iterates(M,X,Y,f,g,W,n,x,z) â¡
ây[M].
pair(M, x, y, z) â§
(âfa[M].
(âz[M].
z â fa â·
(âxa[M].
ây[M].
âxaa[M].
âsx[M].
âr_sx[M].
âf_r_sx[M]. âsn[M]. âmsn[M]. successor(M,n,sn) â§
membership(M,sn,msn) â§
pair(M, xa, y, z) â§
pair(M, xa, x, xaa) â§
upair(M, xa, xa, sx) â§
pre_image(M, msn, sx, r_sx) â§
restriction(M, fa, r_sx, f_r_sx) â§
xaa â msn â§
(empty(M, xa) â¶ y = W) â§
(âm[M].
successor(M, m, xa) â¶
(âgm[M].
is_apply(M, f_r_sx, m, gm) â§ is_banach_functor(M, X, Y, f, g, gm, y))) â§
(is_quasinat(M, xa) ⨠empty(M, y)))) â§
(empty(M, x) â¶ y = W) â§
(âm[M].
successor(M, m, x) â¶
(âgm[M]. is_apply(M, fa, m, gm) â§ is_banach_functor(M, X, Y, f, g, gm, y))) â§
(is_quasinat(M, x) ⨠empty(M, y)))"
synthesize "is_quasinat" from_definition assuming "nonempty"
arity_theorem for "is_quasinat_fm"
synthesize "banach_body_iterates" from_definition assuming "nonempty"
arity_theorem for "banach_body_iterates_fm"
definition banach_is_iterates_body where
"banach_is_iterates_body(M,X,Y,f,g,W,n,y) â¡ âom[M]. omega(M,om) â§ n â om â§
(âsn[M].
âmsn[M].
successor(M, n, sn) â§
membership(M, sn, msn) â§
(âfa[M].
(âz[M].
z â fa â·
(âx[M].
ây[M].
âxa[M].
âsx[M].
âr_sx[M].
âf_r_sx[M].
pair(M, x, y, z) â§
pair(M, x, n, xa) â§
upair(M, x, x, sx) â§
pre_image(M, msn, sx, r_sx) â§
restriction(M, fa, r_sx, f_r_sx) â§
xa â msn â§
(empty(M, x) â¶ y = W) â§
(âm[M].
successor(M, m, x) â¶
(âgm[M].
fun_apply(M, f_r_sx, m, gm) â§ is_banach_functor(M, X, Y, f, g, gm, y))) â§
(is_quasinat(M, x) ⨠empty(M, y)))) â§
(empty(M, n) â¶ y = W) â§
(âm[M].
successor(M, m, n) â¶
(âgm[M]. fun_apply(M, fa, m, gm) â§ is_banach_functor(M, X, Y, f, g, gm, y))) â§
(is_quasinat(M, n) ⨠empty(M, y))))"
synthesize "banach_is_iterates_body" from_definition assuming "nonempty"
arity_theorem for "banach_is_iterates_body_fm"
definition trans_apply_image where
"trans_apply_image(f) ⡠λa g. f ` (g `` a)"
relativize functional "trans_apply_image" "trans_apply_image_rel"
relationalize "trans_apply_image" "is_trans_apply_image"
schematic_goal arity_is_recfun_fm[arity]:
"p â formula â¹ a â Ï â¹ z â Ï â¹ r â Ï â¹ arity(is_recfun_fm(p, a, z ,r)) = ?ar"
unfolding is_recfun_fm_def
by (simp add:arity)
schematic_goal arity_is_wfrec_fm[arity]:
"p â formula â¹ a â Ï â¹ z â Ï â¹ r â Ï â¹ arity(is_wfrec_fm(p, a, z ,r)) = ?ar"
unfolding is_wfrec_fm_def
by (simp add:arity)
schematic_goal arity_is_transrec_fm[arity]:
"p â formula â¹ a â Ï â¹ z â Ï â¹ arity(is_transrec_fm(p, a, z)) = ?ar"
unfolding is_transrec_fm_def
by (simp add:arity)
synthesize "is_trans_apply_image" from_definition assuming "nonempty"
arity_theorem for "is_trans_apply_image_fm"
definition transrec_apply_image_body where
"transrec_apply_image_body(M,f,mesa,x,z) â¡ ây[M]. pair(M, x, y, z) â§
(âfa[M].
(âz[M].
z â fa â·
(âxa[M].
ây[M].
âxaa[M].
âsx[M].
âr_sx[M].
âf_r_sx[M].
pair(M, xa, y, z) â§
pair(M, xa, x, xaa) â§
upair(M, xa, xa, sx) â§
pre_image(M, mesa, sx, r_sx) â§
restriction(M, fa, r_sx, f_r_sx) â§
xaa â mesa â§ is_trans_apply_image(M, f, xa, f_r_sx, y))) â§
is_trans_apply_image(M, f, x, fa, y))"
synthesize "transrec_apply_image_body" from_definition assuming "nonempty"
arity_theorem for "transrec_apply_image_body_fm"
definition is_trans_apply_image_body where
"is_trans_apply_image_body(M,f,β,a,w) â¡ âz[M]. pair(M,a,z,w) â§ aâβ â§ (âsa[M].
âesa[M].
âmesa[M].
upair(M, a, a, sa) â§
is_eclose(M, sa, esa) â§
membership(M, esa, mesa) â§
(âfa[M].
(âz[M].
z â fa â·
(âx[M].
ây[M].
âxa[M].
âsx[M].
âr_sx[M].
âf_r_sx[M].
pair(M, x, y, z) â§
pair(M, x, a, xa) â§
upair(M, x, x, sx) â§
pre_image(M, mesa, sx, r_sx) â§
restriction(M, fa, r_sx, f_r_sx) â§
xa â mesa â§ is_trans_apply_image(M, f, x, f_r_sx, y))) â§
is_trans_apply_image(M, f, a, fa, z)))"
manual_schematic "is_trans_apply_image_body_schematic" for "is_trans_apply_image_body"assuming "nonempty"
unfolding is_trans_apply_image_body_def
by (rule sep_rules is_eclose_iff_sats is_trans_apply_image_iff_sats | simp)+
synthesize "is_trans_apply_image_body" from_schematic "is_trans_apply_image_body_schematic"
arity_theorem for "is_trans_apply_image_body_fm"
synthesize "is_converse" from_definition assuming "nonempty"
arity_theorem for "is_converse_fm"
definition replacement_is_omega_funspace_fm where "replacement_is_omega_funspace_fm â¡ omega_funspace_fm(2,0,1)"
definition replacement_HAleph_wfrec_repl_body_fm where "replacement_HAleph_wfrec_repl_body_fm â¡ HAleph_wfrec_repl_body_fm(2,0,1)"
definition replacement_is_fst2_snd2_fm where "replacement_is_fst2_snd2_fm â¡ is_fst2_snd2_fm(0,1)"
definition replacement_is_sndfst_fst2_snd2_fm where "replacement_is_sndfst_fst2_snd2_fm â¡ is_sndfst_fst2_snd2_fm(0,1)"
definition replacement_is_order_eq_map_fm where "replacement_is_order_eq_map_fm â¡ order_eq_map_fm(2,3,0,1)"
definition replacement_transrec_apply_image_body_fm where "replacement_transrec_apply_image_body_fm â¡ transrec_apply_image_body_fm(3,2,0,1)"
definition banach_replacement_iterates_fm where "banach_replacement_iterates_fm â¡ banach_is_iterates_body_fm(6,5,4,3,2,0,1)"
definition replacement_is_trans_apply_image_fm where "replacement_is_trans_apply_image_fm â¡ is_trans_apply_image_body_fm(3,2,0,1)"
definition banach_iterates_fm where "banach_iterates_fm â¡ banach_body_iterates_fm(7,6,5,4,3,2,0,1)"
definition replacement_dcwit_repl_body_fm where "replacement_dcwit_repl_body_fm â¡ dcwit_repl_body_fm(6,5,4,3,2,0,1)"
locale M_ZF2 = M_ZF1 +
assumes
replacement_ax2:
"replacement_assm(M,env,replacement_is_omega_funspace_fm)"
"replacement_assm(M,env,replacement_HAleph_wfrec_repl_body_fm)"
"replacement_assm(M,env,replacement_is_fst2_snd2_fm)"
"replacement_assm(M,env,replacement_is_sndfst_fst2_snd2_fm)"
"replacement_assm(M,env,replacement_is_order_eq_map_fm)"
"replacement_assm(M,env,replacement_transrec_apply_image_body_fm)"
"replacement_assm(M,env,banach_replacement_iterates_fm)"
"replacement_assm(M,env,replacement_is_trans_apply_image_fm)"
"replacement_assm(M,env,banach_iterates_fm)"
"replacement_assm(M,env,replacement_dcwit_repl_body_fm)"
and
Lambda_in_M_replacement2:
"replacement_assm(M,env,Lambda_in_M_fm(fst_fm(0,1),0))"
"replacement_assm(M,env,Lambda_in_M_fm(domain_fm(0,1),0))"
"replacement_assm(M,env,Lambda_in_M_fm(snd_fm(0,1),0))"
"replacement_assm(M,env,Lambda_in_M_fm(big_union_fm(0,1),0))"
"replacement_assm(M,env,Lambda_in_M_fm(is_cardinal_fm(0,1),0))"
"replacement_assm(M,env,Lambda_in_M_fm(is_converse_fm(0,1),0))"
and
LambdaPair_in_M_replacement2:
"replacement_assm(M,env,LambdaPair_in_M_fm(image_fm(0,1,2),0))"
"replacement_assm(M,env,LambdaPair_in_M_fm(setdiff_fm(0,1,2),0))"
"replacement_assm(M,env,LambdaPair_in_M_fm(minimum_fm(0,1,2),0))"
"replacement_assm(M,env,LambdaPair_in_M_fm(upair_fm(0,1,2),0))"
"replacement_assm(M,env,LambdaPair_in_M_fm(is_RepFun_body_fm(0,1,2),0))"
"replacement_assm(M,env,LambdaPair_in_M_fm(composition_fm(0,1,2),0))"
definition instances2_fms where "instances2_fms â¡
{ replacement_is_omega_funspace_fm,
replacement_HAleph_wfrec_repl_body_fm,
replacement_is_fst2_snd2_fm,
replacement_is_sndfst_fst2_snd2_fm,
replacement_is_order_eq_map_fm,
replacement_transrec_apply_image_body_fm,
banach_replacement_iterates_fm,
replacement_is_trans_apply_image_fm,
banach_iterates_fm,
replacement_dcwit_repl_body_fm,
Lambda_in_M_fm(fst_fm(0,1),0),
Lambda_in_M_fm(domain_fm(0,1),0),
Lambda_in_M_fm(snd_fm(0,1),0),
Lambda_in_M_fm(big_union_fm(0,1),0),
Lambda_in_M_fm(is_cardinal_fm(0,1),0),
Lambda_in_M_fm(is_converse_fm(0,1),0),
LambdaPair_in_M_fm(image_fm(0,1,2),0),
LambdaPair_in_M_fm(setdiff_fm(0,1,2),0),
LambdaPair_in_M_fm(minimum_fm(0,1,2),0),
LambdaPair_in_M_fm(upair_fm(0,1,2),0),
LambdaPair_in_M_fm(is_RepFun_body_fm(0,1,2),0),
LambdaPair_in_M_fm(composition_fm(0,1,2),0) }"
txtâ¹This set has 22 internalized formulas.âº
lemmas replacement_instances2_defs =
replacement_is_omega_funspace_fm_def
replacement_HAleph_wfrec_repl_body_fm_def
replacement_is_fst2_snd2_fm_def
replacement_is_sndfst_fst2_snd2_fm_def
replacement_is_order_eq_map_fm_def
replacement_transrec_apply_image_body_fm_def
banach_replacement_iterates_fm_def
replacement_is_trans_apply_image_fm_def
banach_iterates_fm_def
replacement_dcwit_repl_body_fm_def
declare (in M_ZF2) replacement_instances2_defs [simp]
lemma instances2_fms_type[TC]: "instances2_fms â formula"
unfolding replacement_instances2_defs instances2_fms_def
by (simp del:Lambda_in_M_fm_def)
locale M_ZF2_trans = M_ZF1_trans + M_ZF2
locale M_ZFC2 = M_ZFC1 + M_ZF2
locale M_ZFC2_trans = M_ZFC1_trans + M_ZF2_trans + M_ZFC2
lemma (in M_ZF2_trans) lam_replacement_domain : "lam_replacement(##M, domain)"
using lam_replacement_iff_lam_closed[THEN iffD2,of domain]
Lambda_in_M[where Ï="domain_fm(0,1)" and env="[]"] domain_type domain_abs
Lambda_in_M_replacement2(2)
arity_domain_fm[of 0 1] ord_simp_union transitivity domain_closed
by simp
lemma (in M_ZF2_trans) lam_replacement_converse : "lam_replacement(##M, converse)"
using lam_replacement_iff_lam_closed[THEN iffD2,of converse] nonempty
Lambda_in_M[where Ï="is_converse_fm(0,1)" and env="[]"]
is_converse_fm_type converse_abs
arity_is_converse_fm[of 0 1] ord_simp_union transitivity converse_closed
Lambda_in_M_replacement2(6)
by simp
lemma (in M_ZF2_trans) lam_replacement_fst : "lam_replacement(##M, fst)"
using lam_replacement_iff_lam_closed[THEN iffD2,of fst]
Lambda_in_M[where Ï="fst_fm(0,1)" and env="[]"]
fst_iff_sats[symmetric] fst_abs fst_type
arity_fst_fm[of 0 1] ord_simp_union transitivity fst_closed
Lambda_in_M_replacement2(1)
by simp
lemma (in M_ZF2_trans) lam_replacement_snd : "lam_replacement(##M, snd)"
using lam_replacement_iff_lam_closed[THEN iffD2,of snd]
Lambda_in_M[where Ï="snd_fm(0,1)" and env="[]"]
snd_iff_sats[symmetric] snd_abs snd_type
arity_snd_fm[of 0 1] ord_simp_union transitivity snd_closed
Lambda_in_M_replacement2(3)
by simp
lemma (in M_ZF2_trans) lam_replacement_Union : "lam_replacement(##M, Union)"
using lam_replacement_iff_lam_closed[THEN iffD2,of Union]
Lambda_in_M[where Ï="big_union_fm(0,1)" and env="[]"] Union_abs
union_fm_def big_union_iff_sats[symmetric]
arity_big_union_fm[of 0 1] ord_simp_union transitivity Union_closed
Lambda_in_M_replacement2(4)
by simp
lemma (in M_ZF2_trans) lam_replacement_image:
"lam_replacement(##M, λp. fst(p) `` snd(p))"
using lam_replacement2_in_ctm[where Ï="image_fm(0,1,2)" and env="[]"]
image_type image_iff_sats image_abs
arity_image_fm[of 0 1 2] ord_simp_union transitivity image_closed fst_snd_closed
LambdaPair_in_M_replacement2(1)
by simp
lemma (in M_ZF2_trans) lam_replacement_Diff:
"lam_replacement(##M, λp. fst(p) - snd(p))"
using lam_replacement2_in_ctm[where Ï="setdiff_fm(0,1,2)" and env="[]"]
setdiff_fm_type setdiff_iff_sats setdiff_abs
arity_setdiff_fm[of 0 1 2] ord_simp_union transitivity Diff_closed fst_snd_closed
nonempty LambdaPair_in_M_replacement2(2)
by simp
lemma is_minimum_eq :
"M(R) â¹ M(X) â¹ M(u) â¹ is_minimum(M,R,X,u) â· is_minimum'(M,R,X,u)"
unfolding is_minimum_def is_minimum'_def is_The_def is_first_def by simp
context M_trivial
begin
lemma first_closed:
"M(B) â¹ M(r) â¹ first(u,r,B) â¹ M(u)"
using transM[OF first_is_elem] by simp
is_iff_rel for "first"
unfolding is_first_def first_rel_def by auto
is_iff_rel for "minimum"
unfolding is_minimum_def minimum_rel_def
using is_first_iff The_abs nonempty
by force
end
lemma (in M_ZF2_trans) lam_replacement_minimum:
"lam_replacement(##M, λp. minimum(fst(p), snd(p)))"
using lam_replacement2_in_ctm[where Ï="minimum_fm(0,1,2)" and env="[]"]
minimum_iff_sats[symmetric] is_minimum_iff minimum_abs is_minimum_eq
arity_minimum_fm[of 0 1 2] ord_simp_union minimum_fm_type
minimum_closed zero_in_M LambdaPair_in_M_replacement2(3)
by simp
lemma (in M_ZF2_trans) lam_replacement_Upair: "lam_replacement(##M, λp. Upair(fst(p), snd(p)))"
using lam_replacement2_in_ctm[where Ï="upair_fm(0,1,2)" and env="[]" and f="Upair"]
Upair_closed upair_type upair_iff_sats Upair_eq_cons
arity_upair_fm[of 0 1 2,simplified] ord_simp_union LambdaPair_in_M_replacement2(4)
by simp
lemma (in M_ZF2_trans) lam_replacement_comp:
"lam_replacement(##M, λp. comp(fst(p), snd(p)))"
using lam_replacement2_in_ctm[where Ï="composition_fm(0,1,2)" and env="[]" and f="comp"]
comp_closed composition_fm_type composition_iff_sats
arity_composition_fm[of 0 1 2] ord_simp_union LambdaPair_in_M_replacement2(6)
by simp
lemma (in M_ZF2_trans) omega_funspace_abs:
"BâM â¹ nâM â¹ zâM â¹ is_omega_funspace(##M,B,n,z) â· nâÏ â§ is_funspace(##M,n,B,z)"
unfolding is_omega_funspace_def using nat_in_M by simp
lemma (in M_ZF2_trans) replacement_is_omega_funspace:
"BâM â¹ strong_replacement(##M, is_omega_funspace(##M,B))"
using strong_replacement_rel_in_ctm[where Ï="omega_funspace_fm(2,0,1)" and env="[B]"]
zero_in_M arity_omega_funspace_fm ord_simp_union replacement_ax2(1)
by simp
lemma (in M_ZF2_trans) replacement_omega_funspace:
"bâMâ¹strong_replacement(##M, λn z. nâÏ â§ is_funspace(##M,n,b,z))"
using strong_replacement_cong[THEN iffD2,OF _ replacement_is_omega_funspace[of b]]
omega_funspace_abs[of b] setclass_iff[THEN iffD1]
by (simp del:setclass_iff)
lemma (in M_ZF2_trans) replacement_HAleph_wfrec_repl_body:
"BâM â¹ strong_replacement(##M, HAleph_wfrec_repl_body(##M,B))"
using strong_replacement_rel_in_ctm[where Ï="HAleph_wfrec_repl_body_fm(2,0,1)" and env="[B]"]
zero_in_M arity_HAleph_wfrec_repl_body_fm replacement_ax2(2) ord_simp_union
by simp
lemma (in M_ZF2_trans) HAleph_wfrec_repl:
"(##M)(sa) â¹
(##M)(esa) â¹
(##M)(mesa) â¹
strong_replacement
(##M,
λx z. ây[##M].
pair(##M, x, y, z) â§
(âf[##M].
(âz[##M].
z â f â·
(âxa[##M].
ây[##M].
âxaa[##M].
âsx[##M].
âr_sx[##M].
âf_r_sx[##M].
pair(##M, xa, y, z) â§
pair(##M, xa, x, xaa) â§
upair(##M, xa, xa, sx) â§
pre_image(##M, mesa, sx, r_sx) â§ restriction(##M, f, r_sx, f_r_sx) â§ xaa â mesa â§ is_HAleph(##M, xa, f_r_sx, y))) â§
is_HAleph(##M, x, f, y)))"
using replacement_HAleph_wfrec_repl_body unfolding HAleph_wfrec_repl_body_def by simp
lemma dcwit_replacement:"Ord(na) â¹
N(na) â¹
N(A) â¹
N(a) â¹
N(s) â¹
N(R) â¹
transrec_replacement
(N, λn f ntc.
is_nat_case
(N, a,
λm bmfm.
âfm[N]. âcp[N].
is_apply(N, f, m, fm) â§
is_Collect(N, A, λx. âfmx[N]. (N(x) â§ fmx â R) â§ pair(N, fm, x, fmx), cp) â§
is_apply(N, s, cp, bmfm),
n, ntc),na)"
unfolding transrec_replacement_def wfrec_replacement_def oops
lemma (in M_ZF2_trans) replacement_dcwit_repl_body:
"(##M)(mesa) â¹ (##M)(A) â¹ (##M)(a) â¹ (##M)(s) â¹ (##M)(R) â¹
strong_replacement(##M, dcwit_repl_body(##M,mesa,A,a,s,R))"
using strong_replacement_rel_in_ctm[where Ï="dcwit_repl_body_fm(6,5,4,3,2,0,1)"
and env="[R,s,a,A,mesa]" and f="dcwit_repl_body(##M,mesa,A,a,s,R)"]
zero_in_M arity_dcwit_repl_body replacement_ax2(10)
by simp
lemma (in M_ZF2_trans) dcwit_repl:
"(##M)(sa) â¹
(##M)(esa) â¹
(##M)(mesa) â¹ (##M)(A) â¹ (##M)(a) â¹ (##M)(s) â¹ (##M)(R) â¹
strong_replacement
((##M), λx z. ây[(##M)]. pair((##M), x, y, z) â§
is_wfrec
((##M), λn f. is_nat_case
((##M), a,
λm bmfm.
âfm[(##M)].
âcp[(##M)].
is_apply((##M), f, m, fm) â§
is_Collect((##M), A, λx. âfmx[(##M)]. ((##M)(x) â§ fmx â R) â§ pair((##M), fm, x, fmx), cp) â§
is_apply((##M), s, cp, bmfm),
n),
mesa, x, y))"
using replacement_dcwit_repl_body unfolding dcwit_repl_body_def by simp
lemma (in M_ZF2_trans) replacement_fst2_snd2: "strong_replacement(##M, λx y. y = â¨fst(fst(x)), snd(snd(x))â©)"
using strong_replacement_in_ctm[where Ï="is_fst2_snd2_fm(0,1)" and env="[]"]
zero_in_M fst_snd_closed pair_in_M_iff
arity_is_fst2_snd2_fm ord_simp_union fst2_snd2_abs replacement_ax2(3)
unfolding fst2_snd2_def
by simp
lemma (in M_trivial) sndfst_fst2_snd2_abs:
assumes "M(x)" "M(res)"
shows "is_sndfst_fst2_snd2(M, x, res) â· res = sndfst_fst2_snd2(x)"
unfolding is_sndfst_fst2_snd2_def sndfst_fst2_snd2_def
using fst_rel_abs[symmetric] snd_rel_abs[symmetric] fst_abs snd_abs assms
by simp
lemma (in M_ZF2_trans) replacement_sndfst_fst2_snd2:
"strong_replacement(##M, λx y. y = â¨snd(fst(x)), fst(fst(x)), snd(snd(x))â©)"
using strong_replacement_in_ctm[where Ï="is_sndfst_fst2_snd2_fm(0,1)" and env="[]"]
zero_in_M fst_snd_closed pair_in_M_iff
arity_is_sndfst_fst2_snd2_fm ord_simp_union sndfst_fst2_snd2_abs replacement_ax2(4)
unfolding sndfst_fst2_snd2_def
by simp
lemmas (in M_ZF2_trans) M_replacement_ZF_instances = lam_replacement_domain
lam_replacement_fst lam_replacement_snd lam_replacement_Union
lam_replacement_Upair lam_replacement_image
lam_replacement_Diff lam_replacement_converse
replacement_fst2_snd2 replacement_sndfst_fst2_snd2
lam_replacement_comp
lemmas (in M_ZF2_trans) M_separation_ZF_instances = separation_fstsnd_in_sndsnd
separation_sndfst_eq_fstsnd
sublocale M_ZF2_trans â M_replacement "##M"
using M_replacement_ZF_instances M_separation_ZF_instances
by unfold_locales simp
lemma (in M_ZF1_trans) separation_is_dcwit_body:
assumes "(##M)(A)" "(##M)(a)" "(##M)(g)" "(##M)(R)"
shows "separation(##M,is_dcwit_body(##M, A, a, g, R))"
using assms separation_in_ctm[where env="[A,a,g,R]" and Ï="is_dcwit_body_fm(1,2,3,4,0)",
OF _ _ _ is_dcwit_body_iff_sats[symmetric],
of "λ_.A" "λ_.a" "λ_.g" "λ_.R" "λx. x"]
nonempty arity_is_dcwit_body_fm is_dcwit_body_fm_type
by (simp add:ord_simp_union)
lemma (in M_trivial) RepFun_body_abs:
assumes "M(u)" "M(v)" "M(res)"
shows "is_RepFun_body(M, u, v, res) â· res = RepFun_body(u,v)"
unfolding is_RepFun_body_def RepFun_body_def
using fst_rel_abs[symmetric] snd_rel_abs[symmetric] fst_abs snd_abs assms
Replace_abs[where P="λxa a. a = {â¨v, xaâ©}" and A="u"]
univalent_triv transM[of _ u]
by auto
lemma (in M_ZF2_trans) RepFun_SigFun_closed: "x â M â¹ z â M â¹ {{â¨z, xâ©} . x â x} â M"
using lam_replacement_sing_const_id lam_replacement_imp_strong_replacement RepFun_closed
transitivity singleton_in_M_iff pair_in_M_iff
by simp
lemma (in M_ZF2_trans) replacement_RepFun_body:
"lam_replacement(##M, λp . {{â¨snd(p), xâ©} . x â fst(p)})"
using lam_replacement2_in_ctm[where Ï="is_RepFun_body_fm(0,1,2)" and env="[]" and f="λp q . {{â¨q, xâ©} . x â p}"]
RepFun_SigFun_closed[OF fst_snd_closed[THEN conjunct1,simplified] fst_snd_closed[THEN conjunct2,simplified]]
arity_RepFun ord_simp_union transitivity zero_in_M RepFun_body_def RepFun_body_abs RepFun_SigFun_closed
LambdaPair_in_M_replacement2(5)
by simp
sublocale M_ZF2_trans â M_replacement_extra "##M"
by unfold_locales (simp_all add: replacement_RepFun_body
lam_replacement_minimum del:setclass_iff)
sublocale M_ZF2_trans â M_Perm "##M"
using separation_PiP_rel separation_injP_rel separation_surjP_rel
lam_replacement_imp_strong_replacement[OF
lam_replacement_Sigfun[OF lam_replacement_constant]]
Pi_replacement1 unfolding Sigfun_def
by unfold_locales simp_all
lemma (in M_ZF2_trans) replacement_is_order_eq_map:
"AâM â¹ râM â¹ strong_replacement(##M, order_eq_map(##M,A,r))"
using strong_replacement_rel_in_ctm[where Ï="order_eq_map_fm(2,3,0,1)" and env="[A,r]" and f="order_eq_map(##M,A,r)"]
order_eq_map_iff_sats[where env="[_,_,A,r]"] zero_in_M fst_snd_closed pair_in_M_iff
arity_order_eq_map_fm ord_simp_union replacement_ax2(5)
by simp
lemma (in M_ZF2_trans) banach_iterates:
assumes "XâM" "YâM" "fâM" "gâM" "WâM"
shows "iterates_replacement(##M, is_banach_functor(##M,X,Y,f,g), W)"
proof -
have "strong_replacement(##M, λ x z . banach_body_iterates(##M,X,Y,f,g,W,n,x,z))" if "nâÏ" for n
using assms that arity_banach_body_iterates_fm ord_simp_union nat_into_M
strong_replacement_rel_in_ctm[where Ï="banach_body_iterates_fm(7,6,5,4,3,2,0,1)"
and env="[n,W,g,f,Y,X]"] replacement_ax2(9)
by simp
then
show ?thesis
using assms nat_into_M Memrel_closed
unfolding iterates_replacement_def wfrec_replacement_def is_wfrec_def M_is_recfun_def
is_nat_case_def iterates_MH_def banach_body_iterates_def
by simp
qed
lemma (in M_ZF2_trans) banach_replacement_iterates:
assumes "XâM" "YâM" "fâM" "gâM" "WâM"
shows "strong_replacement(##M, λn y. nâÏ â§ is_iterates(##M,is_banach_functor(##M,X, Y, f, g),W,n,y))"
proof -
have "strong_replacement(##M, λ n z . banach_is_iterates_body(##M,X,Y,f,g,W,n,z))"
using assms arity_banach_is_iterates_body_fm ord_simp_union nat_into_M
strong_replacement_rel_in_ctm[where Ï="banach_is_iterates_body_fm(6,5,4,3,2,0,1)"
and env="[W,g,f,Y,X]"] replacement_ax2(7)
by simp
then
show ?thesis
using assms nat_in_M
unfolding is_iterates_def wfrec_replacement_def is_wfrec_def M_is_recfun_def
is_nat_case_def iterates_MH_def banach_is_iterates_body_def
by simp
qed
lemma (in M_ZF2_trans) banach_replacement:
assumes "(##M)(X)" "(##M)(Y)" "(##M)(f)" "(##M)(g)"
shows "strong_replacement(##M, λn y. nânat â§ y = banach_functor(X, Y, f, g)^n (0))"
using iterates_abs[OF banach_iterates banach_functor_abs,of X Y f g]
assms banach_functor_closed zero_in_M
strong_replacement_cong[THEN iffD1,OF _ banach_replacement_iterates[of X Y f g 0]]
by simp
lemma (in M_ZF2_trans) lam_replacement_cardinal : "lam_replacement(##M, cardinal_rel(##M))"
using lam_replacement_iff_lam_closed[THEN iffD2,of "cardinal_rel(##M)"]
cardinal_rel_closed is_cardinal_iff
Lambda_in_M[where Ï="is_cardinal_fm(0,1)" and env="[]",OF is_cardinal_fm_type[of 0 1]]
arity_is_cardinal_fm[of 0 1] ord_simp_union cardinal_rel_closed transitivity zero_in_M
Lambda_in_M_replacement2(5)
by simp_all
lemma (in M_basic) rel2_trans_apply:
"M(f) â¹ relation2(M,is_trans_apply_image(M,f),trans_apply_image(f))"
unfolding is_trans_apply_image_def trans_apply_image_def relation2_def
by auto
lemma (in M_basic) apply_image_closed:
shows "M(f) â¹ âx[M]. âg[M]. function(g) â¶ M(trans_apply_image(f, x, g))"
unfolding trans_apply_image_def by simp
lemma (in M_basic) apply_image_closed':
shows "M(f) â¹ âx[M]. âg[M]. M(trans_apply_image(f, x, g))"
unfolding trans_apply_image_def by simp
lemma (in M_ZF2_trans) replacement_transrec_apply_image_body :
"(##M)(f) â¹ (##M)(mesa) â¹ strong_replacement(##M,transrec_apply_image_body(##M,f,mesa))"
using strong_replacement_rel_in_ctm[where Ï="transrec_apply_image_body_fm(3,2,0,1)" and env="[mesa,f]"]
zero_in_M arity_transrec_apply_image_body_fm ord_simp_union
replacement_ax2(6)
by simp
lemma (in M_ZF2_trans) transrec_replacement_apply_image:
assumes "(##M)(f)" "(##M)(α)"
shows "transrec_replacement(##M, is_trans_apply_image(##M, f), α)"
unfolding transrec_replacement_def wfrec_replacement_def is_wfrec_def M_is_recfun_def
using replacement_transrec_apply_image_body[unfolded transrec_apply_image_body_def] assms
Memrel_closed singleton_closed eclose_closed
by simp
lemma (in M_ZF2_trans) rec_trans_apply_image_abs:
assumes "(##M)(f)" "(##M)(x)" "(##M)(y)" "Ord(x)"
shows "is_transrec(##M,is_trans_apply_image(##M, f),x,y) â· y = transrec(x,trans_apply_image(f))"
using transrec_abs[OF transrec_replacement_apply_image rel2_trans_apply] assms apply_image_closed
by simp
lemma (in M_ZF2_trans) replacement_is_trans_apply_image:
"(##M)(f) ⹠(##M)(β) ⹠strong_replacement(##M, λ x z .
ây[##M]. pair(##M,x,y,z) â§ xâβ â§ (is_transrec(##M,is_trans_apply_image(##M, f),x,y)))"
unfolding is_transrec_def is_wfrec_def M_is_recfun_def
apply(rule_tac strong_replacement_cong[
where P="λ x z. M,[x,z,β,f] ⨠is_trans_apply_image_body_fm(3,2,0,1)",THEN iffD1])
apply(rule_tac is_trans_apply_image_body_iff_sats[symmetric,unfolded is_trans_apply_image_body_def,where env="[_,_,β,f]"])
apply(simp_all add:zero_in_M)
apply(rule_tac replacement_ax2(8)[unfolded replacement_assm_def, rule_format, where env="[β,f]",simplified])
apply(simp_all add: arity_is_trans_apply_image_body_fm is_trans_apply_image_body_fm_type ord_simp_union)
done
lemma (in M_ZF2_trans) trans_apply_abs:
"(##M)(f) â¹ (##M)(β) â¹ Ord(β) â¹ (##M)(x) â¹ (##M)(z) â¹
(xâβ â§ z = â¨x, transrec(x, λa g. f ` (g `` a)) â©) â·
(ây[##M]. pair(##M,x,y,z) â§ xâβ â§ (is_transrec(##M,is_trans_apply_image(##M, f),x,y)))"
using rec_trans_apply_image_abs Ord_in_Ord
transrec_closed[OF transrec_replacement_apply_image rel2_trans_apply,of f,simplified]
apply_image_closed'[of f]
unfolding trans_apply_image_def
by auto
lemma (in M_ZF2_trans) replacement_trans_apply_image:
"(##M)(f) â¹ (##M)(β) â¹ Ord(β) â¹
strong_replacement(##M, λx y. xâβ â§ y = â¨x, transrec(x, λa g. f ` (g `` a))â©)"
using strong_replacement_cong[THEN iffD1,OF _ replacement_is_trans_apply_image,simplified]
trans_apply_abs Ord_in_Ord
by simp
definition ifrFb_body where
"ifrFb_body(M,b,f,x,i) â¡ x â
(if b = 0 then if i â range(f) then
if M(converse(f) ` i) then converse(f) ` i else 0 else 0 else if M(i) then i else 0)"
relativize functional "ifrFb_body" "ifrFb_body_rel"
relationalize "ifrFb_body_rel" "is_ifrFb_body"
synthesize "is_ifrFb_body" from_definition assuming "nonempty"
arity_theorem for "is_ifrFb_body_fm"
definition ifrangeF_body :: "[iâo,i,i,i,i] â o" where
"ifrangeF_body(M,A,b,f) ⡠λy. âxâA. y = â¨x,μ i. ifrFb_body(M,b,f,x,i)â©"
relativize functional "ifrangeF_body" "ifrangeF_body_rel"
relationalize "ifrangeF_body_rel" "is_ifrangeF_body"
synthesize "is_ifrangeF_body" from_definition assuming "nonempty"
arity_theorem for "is_ifrangeF_body_fm"
lemma (in M_Z_trans) separation_is_ifrangeF_body:
"(##M)(A) â¹ (##M)(r) â¹ (##M)(s) â¹ separation(##M, is_ifrangeF_body(##M,A,r,s))"
using separation_in_ctm[where Ï="is_ifrangeF_body_fm(1,2,3,0)" and env="[A,r,s]"]
zero_in_M arity_is_ifrangeF_body_fm ord_simp_union is_ifrangeF_body_fm_type
by simp
lemma (in M_basic) is_ifrFb_body_closed: "M(r) â¹ M(s) â¹ is_ifrFb_body(M, r, s, x, i) â¹ M(i)"
unfolding ifrangeF_body_def is_ifrangeF_body_def is_ifrFb_body_def If_abs
by (cases "iârange(s)"; cases "r=0"; auto dest:transM)
lemma (in M_ZF1_trans) ifrangeF_body_abs:
assumes "(##M)(A)" "(##M)(r)" "(##M)(s)" "(##M)(x)"
shows "is_ifrangeF_body(##M,A,r,s,x) â· ifrangeF_body(##M,A,r,s,x)"
proof -
{
fix a
assume "aâM"
with assms
have "(μ i. iâ M â§ is_ifrFb_body(##M, r, s, z, i))= (μ i. is_ifrFb_body(##M, r, s, z, i))" for z
using is_ifrFb_body_closed[of r s z]
by (rule_tac Least_cong[of "λi. iâM â§ is_ifrFb_body(##M,r,s,z,i)"]) auto
moreover
have "(μ i. is_ifrFb_body(##M, r, s, z, i))= (μ i. ifrFb_body(##M, r, s, z, i))" for z
proof (rule_tac Least_cong[of "λi. is_ifrFb_body(##M,r,s,z,i)" "λi. ifrFb_body(##M,r,s,z,i)"])
fix y
from assms â¹aâMâº
show "is_ifrFb_body(##M, r, s, z, y) â· ifrFb_body(##M, r, s, z, y)"
using If_abs apply_0
unfolding ifrFb_body_def is_ifrFb_body_def
by (cases "yâM"; cases "yârange(s)"; cases "converse(s)`y â M";
auto dest:transM split del: split_if del:iffI)
(auto simp flip:setclass_iff; (force simp only:setclass_iff))+
qed
moreover from â¹aâMâº
have "least(##M, λi. i â M â§ is_ifrFb_body(##M, r, s, z, i), a)
â· a = (μ i. iâ M â§ is_ifrFb_body(##M, r, s, z,i))" for z
using If_abs least_abs'[of "λi. (##M)(i) ⧠is_ifrFb_body(##M,r,s,z,i)" a]
by simp
ultimately
have "least(##M, λi. i â M â§ is_ifrFb_body(##M, r, s, z, i), a)
ⷠa = (μ i. ifrFb_body(##M, r, s, z,i))" for z
by simp
}
with assms
show ?thesis
using pair_in_M_iff apply_closed zero_in_M transitivity[of _ A]
unfolding ifrangeF_body_def is_ifrangeF_body_def
by (auto dest:transM)
qed
lemma (in M_ZF1_trans) separation_ifrangeF_body:
"(##M)(A) â¹ (##M)(b) â¹ (##M)(f) â¹ separation
(##M, λy. âxâA. y = â¨x, μ i. x â if_range_F_else_F(λx. if (##M)(x) then x else 0, b, f, i)â©)"
using separation_is_ifrangeF_body ifrangeF_body_abs
separation_cong[where P="is_ifrangeF_body(##M,A,b,f)" and M="##M",THEN iffD1]
unfolding ifrangeF_body_def if_range_F_def if_range_F_else_F_def ifrFb_body_def
by simp
definition ifrFb_body2 where
"ifrFb_body2(M,G,b,f,x,i) â¡ x â
(if b = 0 then if i â range(f) then
if M(converse(f) ` i) then G`(converse(f) ` i) else 0 else 0 else if M(i) then G`i else 0)"
relativize functional "ifrFb_body2" "ifrFb_body2_rel"
relationalize "ifrFb_body2_rel" "is_ifrFb_body2"
synthesize "is_ifrFb_body2" from_definition assuming "nonempty"
arity_theorem for "is_ifrFb_body2_fm"
definition ifrangeF_body2 :: "[iâo,i,i,i,i,i] â o" where
"ifrangeF_body2(M,A,G,b,f) ⡠λy. âxâA. y = â¨x,μ i. ifrFb_body2(M,G,b,f,x,i)â©"
relativize functional "ifrangeF_body2" "ifrangeF_body2_rel"
relationalize "ifrangeF_body2_rel" "is_ifrangeF_body2"
synthesize "is_ifrangeF_body2" from_definition assuming "nonempty"
arity_theorem for "is_ifrangeF_body2_fm"
lemma (in M_Z_trans) separation_is_ifrangeF_body2:
"(##M)(A) â¹ (##M)(G) â¹ (##M)(r) â¹ (##M)(s) â¹ separation(##M, is_ifrangeF_body2(##M,A,G,r,s))"
using separation_in_ctm[where Ï="is_ifrangeF_body2_fm(1,2,3,4,0)" and env="[A,G,r,s]"]
zero_in_M arity_is_ifrangeF_body2_fm ord_simp_union is_ifrangeF_body2_fm_type
by simp
lemma (in M_basic) is_ifrFb_body2_closed: "M(G) â¹ M(r) â¹ M(s) â¹ is_ifrFb_body2(M, G, r, s, x, i) â¹ M(i)"
unfolding ifrangeF_body2_def is_ifrangeF_body2_def is_ifrFb_body2_def If_abs
by (cases "iârange(s)"; cases "r=0"; auto dest:transM)
lemma (in M_ZF1_trans) ifrangeF_body2_abs:
assumes "(##M)(A)" "(##M)(G)" "(##M)(r)" "(##M)(s)" "(##M)(x)"
shows "is_ifrangeF_body2(##M,A,G,r,s,x) â· ifrangeF_body2(##M,A,G,r,s,x)"
proof -
{
fix a
assume "aâM"
with assms
have "(μ i. iâ M â§ is_ifrFb_body2(##M, G, r, s, z, i))= (μ i. is_ifrFb_body2(##M, G, r, s, z, i))" for z
using is_ifrFb_body2_closed[of G r s z]
by (rule_tac Least_cong[of "λi. iâM â§ is_ifrFb_body2(##M,G,r,s,z,i)"]) auto
moreover
have "(μ i. is_ifrFb_body2(##M, G, r, s, z, i))= (μ i. ifrFb_body2(##M, G, r, s, z, i))" for z
proof (rule_tac Least_cong[of "λi. is_ifrFb_body2(##M,G,r,s,z,i)" "λi. ifrFb_body2(##M,G,r,s,z,i)"])
fix y
from assms â¹aâMâº
show "is_ifrFb_body2(##M, G, r, s, z, y) â· ifrFb_body2(##M, G, r, s, z, y)"
using If_abs apply_0
unfolding ifrFb_body2_def is_ifrFb_body2_def
by (cases "yâM"; cases "yârange(s)"; cases "converse(s)`y â M";
auto dest:transM split del: split_if del:iffI)
(auto simp flip:setclass_iff; (force simp only:setclass_iff))+
qed
moreover from â¹aâMâº
have "least(##M, λi. i â M â§ is_ifrFb_body2(##M, G, r, s, z, i), a)
â· a = (μ i. iâ M â§ is_ifrFb_body2(##M, G, r, s, z,i))" for z
using If_abs least_abs'[of "λi. (##M)(i) ⧠is_ifrFb_body2(##M,G,r,s,z,i)" a]
by simp
ultimately
have "least(##M, λi. i â M â§ is_ifrFb_body2(##M, G, r, s, z, i), a)
ⷠa = (μ i. ifrFb_body2(##M, G, r, s, z,i))" for z
by simp
}
with assms
show ?thesis
using pair_in_M_iff apply_closed zero_in_M transitivity[of _ A]
unfolding ifrangeF_body2_def is_ifrangeF_body2_def
by (auto dest:transM)
qed
lemma (in M_ZF1_trans) separation_ifrangeF_body2:
"(##M)(A) â¹ (##M)(G) â¹ (##M)(b) â¹ (##M)(f) â¹
separation
(##M,
λy. âxâA.
y =
â¨x, μ i. x â
if_range_F_else_F(λa. if (##M)(a) then G ` a else 0, b, f, i)â©)"
using separation_is_ifrangeF_body2 ifrangeF_body2_abs
separation_cong[where P="is_ifrangeF_body2(##M,A,G,b,f)" and M="##M",THEN iffD1]
unfolding ifrangeF_body2_def if_range_F_def if_range_F_else_F_def ifrFb_body2_def
by simp
definition ifrFb_body3 where
"ifrFb_body3(M,G,b,f,x,i) â¡ x â
(if b = 0 then if i â range(f) then
if M(converse(f) ` i) then G-``{converse(f) ` i} else 0 else 0 else if M(i) then G-``{i} else 0)"
relativize functional "ifrFb_body3" "ifrFb_body3_rel"
relationalize "ifrFb_body3_rel" "is_ifrFb_body3"
synthesize "is_ifrFb_body3" from_definition assuming "nonempty"
arity_theorem for "is_ifrFb_body3_fm"
definition ifrangeF_body3 :: "[iâo,i,i,i,i,i] â o" where
"ifrangeF_body3(M,A,G,b,f) ⡠λy. âxâA. y = â¨x,μ i. ifrFb_body3(M,G,b,f,x,i)â©"
relativize functional "ifrangeF_body3" "ifrangeF_body3_rel"
relationalize "ifrangeF_body3_rel" "is_ifrangeF_body3"
synthesize "is_ifrangeF_body3" from_definition assuming "nonempty"
arity_theorem for "is_ifrangeF_body3_fm"
lemma (in M_Z_trans) separation_is_ifrangeF_body3:
"(##M)(A) â¹ (##M)(G) â¹ (##M)(r) â¹ (##M)(s) â¹ separation(##M, is_ifrangeF_body3(##M,A,G,r,s))"
using separation_in_ctm[where Ï="is_ifrangeF_body3_fm(1,2,3,4,0)" and env="[A,G,r,s]"]
zero_in_M arity_is_ifrangeF_body3_fm ord_simp_union is_ifrangeF_body3_fm_type
by simp
lemma (in M_basic) is_ifrFb_body3_closed: "M(G) â¹ M(r) â¹ M(s) â¹ is_ifrFb_body3(M, G, r, s, x, i) â¹ M(i)"
unfolding ifrangeF_body3_def is_ifrangeF_body3_def is_ifrFb_body3_def If_abs
by (cases "iârange(s)"; cases "r=0"; auto dest:transM)
lemma (in M_ZF1_trans) ifrangeF_body3_abs:
assumes "(##M)(A)" "(##M)(G)" "(##M)(r)" "(##M)(s)" "(##M)(x)"
shows "is_ifrangeF_body3(##M,A,G,r,s,x) â· ifrangeF_body3(##M,A,G,r,s,x)"
proof -
{
fix a
assume "aâM"
with assms
have "(μ i. iâ M â§ is_ifrFb_body3(##M, G, r, s, z, i))= (μ i. is_ifrFb_body3(##M, G, r, s, z, i))" for z
using is_ifrFb_body3_closed[of G r s z]
by (rule_tac Least_cong[of "λi. iâM â§ is_ifrFb_body3(##M,G,r,s,z,i)"]) auto
moreover
have "(μ i. is_ifrFb_body3(##M, G, r, s, z, i))= (μ i. ifrFb_body3(##M, G, r, s, z, i))" for z
proof (rule_tac Least_cong[of "λi. is_ifrFb_body3(##M,G,r,s,z,i)" "λi. ifrFb_body3(##M,G,r,s,z,i)"])
fix y
from assms â¹aâMâº
show "is_ifrFb_body3(##M, G, r, s, z, y) â· ifrFb_body3(##M, G, r, s, z, y)"
using If_abs apply_0
unfolding ifrFb_body3_def is_ifrFb_body3_def
by (cases "yâM"; cases "yârange(s)"; cases "converse(s)`y â M";
auto dest:transM split del: split_if del:iffI)
(auto simp flip:setclass_iff; (force simp only:setclass_iff))+
qed
moreover from â¹aâMâº
have "least(##M, λi. i â M â§ is_ifrFb_body3(##M, G, r, s, z, i), a)
â· a = (μ i. iâ M â§ is_ifrFb_body3(##M, G, r, s, z,i))" for z
using If_abs least_abs'[of "λi. (##M)(i) ⧠is_ifrFb_body3(##M,G,r,s,z,i)" a]
by simp
ultimately
have "least(##M, λi. i â M â§ is_ifrFb_body3(##M, G, r, s, z, i), a)
ⷠa = (μ i. ifrFb_body3(##M, G, r, s, z,i))" for z
by simp
}
with assms
show ?thesis
using pair_in_M_iff apply_closed zero_in_M transitivity[of _ A]
unfolding ifrangeF_body3_def is_ifrangeF_body3_def
by (auto dest:transM)
qed
lemma (in M_ZF1_trans) separation_ifrangeF_body3:
"(##M)(A) â¹ (##M)(G) â¹ (##M)(b) â¹ (##M)(f) â¹
separation
(##M,
λy. âxâA.
y =
â¨x, μ i. x â
if_range_F_else_F(λa. if (##M)(a) then G-``{a} else 0, b, f, i)â©)"
using separation_is_ifrangeF_body3 ifrangeF_body3_abs
separation_cong[where P="is_ifrangeF_body3(##M,A,G,b,f)" and M="##M",THEN iffD1]
unfolding ifrangeF_body3_def if_range_F_def if_range_F_else_F_def ifrFb_body3_def
by simp
definition ifrFb_body4 where
"ifrFb_body4(G,b,f,x,i) â¡ x â
(if b = 0 then if i â range(f) then G`(converse(f) ` i) else 0 else G`i)"
relativize functional "ifrFb_body4" "ifrFb_body4_rel"
relationalize "ifrFb_body4_rel" "is_ifrFb_body4"
synthesize "is_ifrFb_body4" from_definition assuming "nonempty"
arity_theorem for "is_ifrFb_body4_fm"
definition ifrangeF_body4 :: "[iâo,i,i,i,i,i] â o" where
"ifrangeF_body4(M,A,G,b,f) ⡠λy. âxâA. y = â¨x,μ i. ifrFb_body4(G,b,f,x,i)â©"
relativize functional "ifrangeF_body4" "ifrangeF_body4_rel"
relationalize "ifrangeF_body4_rel" "is_ifrangeF_body4"
synthesize "is_ifrangeF_body4" from_definition assuming "nonempty"
arity_theorem for "is_ifrangeF_body4_fm"
lemma (in M_Z_trans) separation_is_ifrangeF_body4:
"(##M)(A) â¹ (##M)(G) â¹ (##M)(r) â¹ (##M)(s) â¹ separation(##M, is_ifrangeF_body4(##M,A,G,r,s))"
using separation_in_ctm[where Ï="is_ifrangeF_body4_fm(1,2,3,4,0)" and env="[A,G,r,s]"]
zero_in_M arity_is_ifrangeF_body4_fm ord_simp_union is_ifrangeF_body4_fm_type
by simp
lemma (in M_basic) is_ifrFb_body4_closed: "M(G) â¹ M(r) â¹ M(s) â¹ is_ifrFb_body4(M, G, r, s, x, i) â¹ M(i)"
using If_abs
unfolding ifrangeF_body4_def is_ifrangeF_body4_def is_ifrFb_body4_def fun_apply_def
by (cases "iârange(s)"; cases "r=0"; auto dest:transM)
lemma (in M_ZF1_trans) ifrangeF_body4_abs:
assumes "(##M)(A)" "(##M)(G)" "(##M)(r)" "(##M)(s)" "(##M)(x)"
shows "is_ifrangeF_body4(##M,A,G,r,s,x) â· ifrangeF_body4(##M,A,G,r,s,x)"
proof -
{
fix a
assume "aâM"
with assms
have "(μ i. iâ M â§ is_ifrFb_body4(##M, G, r, s, z, i))= (μ i. is_ifrFb_body4(##M, G, r, s, z, i))" for z
using is_ifrFb_body4_closed[of G r s z]
by (rule_tac Least_cong[of "λi. iâM â§ is_ifrFb_body4(##M,G,r,s,z,i)"]) auto
moreover
have "(μ i. is_ifrFb_body4(##M, G, r, s, z, i))= (μ i. ifrFb_body4(G, r, s, z, i))" if "zâM" for z
proof (rule_tac Least_cong[of "λi. is_ifrFb_body4(##M,G,r,s,z,i)" "λi. ifrFb_body4(G,r,s,z,i)"])
fix y
from assms â¹aâM⺠â¹zâMâº
show "is_ifrFb_body4(##M, G, r, s, z, y) â· ifrFb_body4(G, r, s, z, y)"
using If_abs apply_0
unfolding ifrFb_body4_def is_ifrFb_body4_def
apply (cases "yâM"; cases "yârange(s)"; cases "r=0"; cases "yâdomain(G)";
auto dest:transM split del: split_if del:iffI)
by (auto simp flip:setclass_iff; (force simp only: fun_apply_def setclass_iff))
(auto simp flip:setclass_iff simp: fun_apply_def )
qed
moreover from â¹aâMâº
have "least(##M, λi. i â M â§ is_ifrFb_body4(##M, G, r, s, z, i), a)
â· a = (μ i. iâ M â§ is_ifrFb_body4(##M, G, r, s, z,i))" for z
using If_abs least_abs'[of "λi. (##M)(i) ⧠is_ifrFb_body4(##M,G,r,s,z,i)" a]
by simp
ultimately
have "zâM â¹ least(##M, λi. i â M â§ is_ifrFb_body4(##M, G, r, s, z, i), a)
ⷠa = (μ i. ifrFb_body4(G, r, s, z,i))" for z
by simp
}
with assms
show ?thesis
using pair_in_M_iff apply_closed zero_in_M transitivity[of _ A]
unfolding ifrangeF_body4_def is_ifrangeF_body4_def
by (auto dest:transM)
qed
lemma (in M_ZF1_trans) separation_ifrangeF_body4:
"(##M)(A) â¹ (##M)(G) â¹ (##M)(b) â¹ (##M)(f) â¹
separation(##M, λy. âxâA. y = â¨x, μ i. x â if_range_F_else_F((`)(G), b, f, i)â©)"
using separation_is_ifrangeF_body4 ifrangeF_body4_abs
separation_cong[where P="is_ifrangeF_body4(##M,A,G,b,f)" and M="##M",THEN iffD1]
unfolding ifrangeF_body4_def if_range_F_def if_range_F_else_F_def ifrFb_body4_def
by simp
definition ifrFb_body5 where
"ifrFb_body5(G,b,f,x,i) â¡ x â
(if b = 0 then if i â range(f) then {xa â G . converse(f) ` i â xa} else 0 else {xa â G . i â xa})"
relativize functional "ifrFb_body5" "ifrFb_body5_rel"
relationalize "ifrFb_body5_rel" "is_ifrFb_body5"
synthesize "is_ifrFb_body5" from_definition assuming "nonempty"
arity_theorem for "is_ifrFb_body5_fm"
definition ifrangeF_body5 :: "[iâo,i,i,i,i,i] â o" where
"ifrangeF_body5(M,A,G,b,f) ⡠λy. âxâA. y = â¨x,μ i. ifrFb_body5(G,b,f,x,i)â©"
relativize functional "ifrangeF_body5" "ifrangeF_body5_rel"
relationalize "ifrangeF_body5_rel" "is_ifrangeF_body5"
synthesize "is_ifrangeF_body5" from_definition assuming "nonempty"
arity_theorem for "is_ifrangeF_body5_fm"
lemma (in M_Z_trans) separation_is_ifrangeF_body5:
"(##M)(A) â¹ (##M)(G) â¹ (##M)(r) â¹ (##M)(s) â¹ separation(##M, is_ifrangeF_body5(##M,A,G,r,s))"
using separation_in_ctm[where Ï="is_ifrangeF_body5_fm(1,2,3,4,0)" and env="[A,G,r,s]"]
zero_in_M arity_is_ifrangeF_body5_fm ord_simp_union is_ifrangeF_body5_fm_type
by simp
lemma (in M_basic) is_ifrFb_body5_closed: "M(G) â¹ M(r) â¹ M(s) â¹ is_ifrFb_body5(M, G, r, s, x, i) â¹ M(i)"
using If_abs
unfolding ifrangeF_body5_def is_ifrangeF_body5_def is_ifrFb_body5_def fun_apply_def
by (cases "iârange(s)"; cases "r=0"; auto dest:transM)
lemma (in M_ZF1_trans) ifrangeF_body5_abs:
assumes "(##M)(A)" "(##M)(G)" "(##M)(r)" "(##M)(s)" "(##M)(x)"
shows "is_ifrangeF_body5(##M,A,G,r,s,x) â· ifrangeF_body5(##M,A,G,r,s,x)"
proof -
{
fix a
assume "aâM"
with assms
have "(μ i. iâ M â§ is_ifrFb_body5(##M, G, r, s, z, i))= (μ i. is_ifrFb_body5(##M, G, r, s, z, i))" for z
using is_ifrFb_body5_closed[of G r s z]
by (rule_tac Least_cong[of "λi. iâM â§ is_ifrFb_body5(##M,G,r,s,z,i)"]) auto
moreover
have "(μ i. is_ifrFb_body5(##M, G, r, s, z, i))= (μ i. ifrFb_body5(G, r, s, z, i))" if "zâM" for z
proof (rule_tac Least_cong[of "λi. is_ifrFb_body5(##M,G,r,s,z,i)" "λi. ifrFb_body5(G,r,s,z,i)"])
fix y
from assms â¹aâM⺠â¹zâMâº
show "is_ifrFb_body5(##M, G, r, s, z, y) â· ifrFb_body5(G, r, s, z, y)"
using If_abs apply_0 separation_in_constant separation_in_rev
unfolding ifrFb_body5_def is_ifrFb_body5_def
apply (cases "yâM"; cases "yârange(s)"; cases "r=0"; cases "yâdomain(G)";
auto dest:transM split del: split_if del:iffI)
apply (auto simp flip:setclass_iff; (force simp only: fun_apply_def setclass_iff))
apply (auto simp flip:setclass_iff simp: fun_apply_def)
apply (auto dest:transM)
done
qed
moreover from â¹aâMâº
have "least(##M, λi. i â M â§ is_ifrFb_body5(##M, G, r, s, z, i), a)
â· a = (μ i. iâ M â§ is_ifrFb_body5(##M, G, r, s, z,i))" for z
using If_abs least_abs'[of "λi. (##M)(i) ⧠is_ifrFb_body5(##M,G,r,s,z,i)" a]
by simp
ultimately
have "zâM â¹ least(##M, λi. i â M â§ is_ifrFb_body5(##M, G, r, s, z, i), a)
ⷠa = (μ i. ifrFb_body5(G, r, s, z,i))" for z
by simp
}
with assms
show ?thesis
using pair_in_M_iff apply_closed zero_in_M transitivity[of _ A]
unfolding ifrangeF_body5_def is_ifrangeF_body5_def
by (auto dest:transM)
qed
lemma (in M_ZF1_trans) separation_ifrangeF_body5:
"(##M)(A) â¹ (##M)(G) â¹ (##M)(b) â¹ (##M)(f) â¹
separation(##M, λy. âxâA. y = â¨x, μ i. x â if_range_F_else_F(λx. {xa â G . x â xa}, b, f, i)â©)"
using separation_is_ifrangeF_body5 ifrangeF_body5_abs
separation_cong[where P="is_ifrangeF_body5(##M,A,G,b,f)" and M="##M",THEN iffD1]
unfolding ifrangeF_body5_def if_range_F_def if_range_F_else_F_def ifrFb_body5_def
by simp
definition ifrFb_body6 where
"ifrFb_body6(G,b,f,x,i) â¡ x â
(if b = 0 then if i â range(f) then {pâG . domain(p) = converse(f) ` i} else 0 else {pâG . domain(p) = i})"
relativize functional "ifrFb_body6" "ifrFb_body6_rel"
relationalize "ifrFb_body6_rel" "is_ifrFb_body6"
synthesize "is_ifrFb_body6" from_definition assuming "nonempty"
arity_theorem for "is_ifrFb_body6_fm"
definition ifrangeF_body6 :: "[iâo,i,i,i,i,i] â o" where
"ifrangeF_body6(M,A,G,b,f) ⡠λy. âxâA. y = â¨x,μ i. ifrFb_body6(G,b,f,x,i)â©"
relativize functional "ifrangeF_body6" "ifrangeF_body6_rel"
relationalize "ifrangeF_body6_rel" "is_ifrangeF_body6"
synthesize "is_ifrangeF_body6" from_definition assuming "nonempty"
arity_theorem for "is_ifrangeF_body6_fm"
lemma (in M_Z_trans) separation_is_ifrangeF_body6:
"(##M)(A) â¹ (##M)(G) â¹ (##M)(r) â¹ (##M)(s) â¹ separation(##M, is_ifrangeF_body6(##M,A,G,r,s))"
using separation_in_ctm[where Ï="is_ifrangeF_body6_fm(1,2,3,4,0)" and env="[A,G,r,s]"]
zero_in_M arity_is_ifrangeF_body6_fm ord_simp_union is_ifrangeF_body6_fm_type
by simp
lemma (in M_basic) ifrFb_body6_closed: "M(G) â¹ M(r) â¹ M(s) â¹ ifrFb_body6(G, r, s, x, i) â· M(i) â§ ifrFb_body6(G, r, s, x, i)"
using If_abs
unfolding ifrangeF_body6_def is_ifrangeF_body6_def ifrFb_body6_def fun_apply_def
by (cases "iârange(s)"; cases "r=0"; auto dest:transM)
lemma (in M_basic) is_ifrFb_body6_closed: "M(G) â¹ M(r) â¹ M(s) â¹ is_ifrFb_body6(M, G, r, s, x, i) â¹ M(i)"
using If_abs
unfolding ifrangeF_body6_def is_ifrangeF_body6_def is_ifrFb_body6_def fun_apply_def
by (cases "iârange(s)"; cases "r=0"; auto dest:transM)
lemma (in M_ZF2_trans) ifrangeF_body6_abs:
assumes "(##M)(A)" "(##M)(G)" "(##M)(r)" "(##M)(s)" "(##M)(x)"
shows "is_ifrangeF_body6(##M,A,G,r,s,x) â· ifrangeF_body6(##M,A,G,r,s,x)"
proof -
{
fix a
assume "aâM"
with assms
have "(μ i. iâ M â§ is_ifrFb_body6(##M, G, r, s, z, i))= (μ i. is_ifrFb_body6(##M, G, r, s, z, i))" for z
using is_ifrFb_body6_closed[of G r s z]
by (rule_tac Least_cong[of "λi. iâM â§ is_ifrFb_body6(##M,G,r,s,z,i)"]) auto
moreover
have "(μ i. iâM â§ is_ifrFb_body6(##M, G, r, s, z, i))= (μ i. iâM â§ ifrFb_body6(G, r, s, z, i))" if "zâM" for z
proof (rule_tac Least_cong[of "λi. iâM â§ is_ifrFb_body6(##M,G,r,s,z,i)" "λi. iâM â§ ifrFb_body6(G,r,s,z,i)"])
fix y
from assms â¹aâM⺠â¹zâMâº
show "yâM â§ is_ifrFb_body6(##M, G, r, s, z, y) â· yâM â§ ifrFb_body6(G, r, s, z, y)"
using If_abs apply_0 separation_in_constant transitivity[of _ G]
separation_closed converse_closed apply_closed range_closed zero_in_M
separation_cong[OF eq_commute,THEN iffD1,OF domain_eq_separation]
unfolding ifrFb_body6_def is_ifrFb_body6_def
by auto
qed
moreover from â¹aâMâº
have "least(##M, λi. i â M â§ is_ifrFb_body6(##M, G, r, s, z, i), a)
â· a = (μ i. iâ M â§ is_ifrFb_body6(##M, G, r, s, z,i))" for z
using If_abs least_abs'[of "λi. (##M)(i) ⧠is_ifrFb_body6(##M,G,r,s,z,i)" a]
by simp
ultimately
have "zâM â¹ least(##M, λi. i â M â§ is_ifrFb_body6(##M, G, r, s, z, i), a)
ⷠa = (μ i. ifrFb_body6(G, r, s, z,i))" for z
using Least_cong[OF ifrFb_body6_closed[of G r s]] assms
by simp
}
with assms
show ?thesis
using pair_in_M_iff apply_closed zero_in_M transitivity[of _ A]
unfolding ifrangeF_body6_def is_ifrangeF_body6_def
by (auto dest:transM)
qed
lemma (in M_ZF2_trans) separation_ifrangeF_body6:
"(##M)(A) â¹ (##M)(G) â¹ (##M)(b) â¹ (##M)(f) â¹
separation(##M,
λy. âxâA. y = â¨x, μ i. x â if_range_F_else_F(λa. {p â G . domain(p) = a}, b, f, i)â©)"
using separation_is_ifrangeF_body6 ifrangeF_body6_abs
separation_cong[where P="is_ifrangeF_body6(##M,A,G,b,f)" and M="##M",THEN iffD1]
unfolding ifrangeF_body6_def if_range_F_def if_range_F_else_F_def ifrFb_body6_def
by simp
definition ifrFb_body7 where
"ifrFb_body7(B,D,A,b,f,x,i) â¡ x â
(if b = 0 then if i â range(f) then
{d â D . ârâA. restrict(r, B) = converse(f) ` i â§ d = domain(r)} else 0
else {d â D . ârâA. restrict(r, B) = i â§ d = domain(r)})"
relativize functional "ifrFb_body7" "ifrFb_body7_rel"
relationalize "ifrFb_body7_rel" "is_ifrFb_body7"
synthesize "is_ifrFb_body7" from_definition assuming "nonempty"
arity_theorem for "is_ifrFb_body7_fm"
definition ifrangeF_body7 :: "[iâo,i,i,i,i,i,i,i] â o" where
"ifrangeF_body7(M,A,B,D,G,b,f) ⡠λy. âxâA. y = â¨x,μ i. ifrFb_body7(B,D,G,b,f,x,i)â©"
relativize functional "ifrangeF_body7" "ifrangeF_body7_rel"
relationalize "ifrangeF_body7_rel" "is_ifrangeF_body7"
synthesize "is_ifrangeF_body7" from_definition assuming "nonempty"
arity_theorem for "is_ifrangeF_body7_fm"
lemma (in M_Z_trans) separation_is_ifrangeF_body7:
"(##M)(A) â¹ (##M)(B) â¹ (##M)(D) â¹ (##M)(G) â¹ (##M)(r) â¹ (##M)(s) â¹ separation(##M, is_ifrangeF_body7(##M,A,B,D,G,r,s))"
using separation_in_ctm[where Ï="is_ifrangeF_body7_fm(1,2,3,4,5,6,0)" and env="[A,B,D,G,r,s]"]
zero_in_M arity_is_ifrangeF_body7_fm ord_simp_union is_ifrangeF_body7_fm_type
by simp
lemma (in M_basic) ifrFb_body7_closed: "M(B) â¹ M(D) â¹ M(G) â¹ M(r) â¹ M(s) â¹
ifrFb_body7(B,D,G, r, s, x, i) â· M(i) â§ ifrFb_body7(B,D,G, r, s, x, i)"
using If_abs
unfolding ifrangeF_body7_def is_ifrangeF_body7_def ifrFb_body7_def fun_apply_def
by (cases "iârange(s)"; cases "r=0"; auto dest:transM)
lemma (in M_basic) is_ifrFb_body7_closed: "M(B) â¹ M(D) â¹ M(G) â¹ M(r) â¹ M(s) â¹
is_ifrFb_body7(M, B,D,G, r, s, x, i) â¹ M(i)"
using If_abs
unfolding ifrangeF_body7_def is_ifrangeF_body7_def is_ifrFb_body7_def fun_apply_def
by (cases "iârange(s)"; cases "r=0"; auto dest:transM)
lemma (in M_ZF2_trans) ifrangeF_body7_abs:
assumes "(##M)(A)" "(##M)(B)" "(##M)(D)" "(##M)(G)" "(##M)(r)" "(##M)(s)" "(##M)(x)"
shows "is_ifrangeF_body7(##M,A,B,D,G,r,s,x) â· ifrangeF_body7(##M,A,B,D,G,r,s,x)"
proof -
from assms
have sep_dr: "yâM â¹ separation(##M, λd . ârâM . râGâ§ y = restrict(r, B) â§ d = domain(r))" for y
by(rule_tac separation_cong[where P'="λd . ârâ M . râG â§ y = restrict(r, B) â§ d = domain(r)",THEN iffD1,OF _
separation_restrict_eq_dom_eq[rule_format,of G B y]],auto simp:transitivity[of _ G])
from assms
have sep_dr'': "yâM â¹ separation(##M, λd . ârâM. r â G â§ d = domain(r) â§ converse(s) ` y = restrict(r, B))" for y
apply(rule_tac separation_cong[where P'="λd . ârâ M . râG â§ d = domain(r) â§ converse(s) ` y = restrict(r, B)",THEN iffD1,OF _ separation_restrict_eq_dom_eq[rule_format,of G B "converse(s) ` y "]])
by(auto simp:transitivity[of _ G] apply_closed[simplified] converse_closed[simplified])
from assms
have sep_dr':"separation(##M, λx. ârâM. r â G â§ x = domain(r) â§ 0 = restrict(r, B))"
apply(rule_tac separation_cong[where P'="λd . ârâ M . râG â§ d = domain(r) â§ 0 = restrict(r, B)",THEN iffD1,OF _ separation_restrict_eq_dom_eq[rule_format,of G B 0]])
by(auto simp:transitivity[of _ G] zero_in_M)
{
fix a
assume "aâM"
with assms
have "(μ i. iâ M â§ is_ifrFb_body7(##M, B,D,G, r, s, z, i))= (μ i. is_ifrFb_body7(##M,B,D, G, r, s, z, i))" for z
using is_ifrFb_body7_closed[of B D G r s z]
by (rule_tac Least_cong[of "λi. iâM â§ is_ifrFb_body7(##M,B,D,G,r,s,z,i)"]) auto
moreover from this
have "(μ i. iâM â§ is_ifrFb_body7(##M, B,D,G, r, s, z, i))= (μ i. iâM â§ ifrFb_body7(B,D,G, r, s, z, i))" if "zâM" for z
proof (rule_tac Least_cong[of "λi. iâM â§ is_ifrFb_body7(##M,B,D,G,r,s,z,i)" "λi. iâM â§ ifrFb_body7(B,D,G,r,s,z,i)"])
from assms â¹aâM⺠â¹zâMâº
have "is_ifrFb_body7(##M, B,D,G, r, s, z, y) â· ifrFb_body7(B,D,G, r, s, z, y)" if "yâM" for y
using If_abs apply_0
separation_closed converse_closed apply_closed range_closed zero_in_M
separation_restrict_eq_dom_eq
transitivity[of _ D] transitivity[of _ G] that sep_dr sep_dr' sep_dr''
unfolding ifrFb_body7_def is_ifrFb_body7_def
by auto
then
show " y â M â§ is_ifrFb_body7(##M, B, D, G, r, s, z, y) â· y â M â§ ifrFb_body7(B, D, G, r, s, z, y)" for y
using conj_cong
by simp
qed
moreover from â¹aâMâº
have "least(##M, λi. i â M â§ is_ifrFb_body7(##M, B,D,G, r, s, z, i), a)
â· a = (μ i. iâ M â§ is_ifrFb_body7(##M,B,D,G, r, s, z,i))" for z
using If_abs least_abs'[of "λi. (##M)(i) ⧠is_ifrFb_body7(##M,B,D,G,r,s,z,i)" a]
by simp
ultimately
have "zâM â¹ least(##M, λi. i â M â§ is_ifrFb_body7(##M,B,D,G, r, s, z, i), a)
ⷠa = (μ i. ifrFb_body7(B,D,G, r, s, z,i))" for z
using Least_cong[OF ifrFb_body7_closed[of B D G r s]] assms
by simp
}
with assms
show ?thesis
using pair_in_M_iff apply_closed zero_in_M transitivity[of _ A]
unfolding ifrangeF_body7_def is_ifrangeF_body7_def
by (auto dest:transM)
qed
lemma (in M_ZF2_trans) separation_ifrangeF_body7:
"(##M)(A) â¹ (##M)(B) â¹ (##M)(D) â¹ (##M)(G) â¹ (##M)(b) â¹ (##M)(f) â¹
separation(##M,
λy. âxâA. y = â¨x, μ i. x â if_range_F_else_F(drSR_Y(B, D, G), b, f, i)â©)"
using separation_is_ifrangeF_body7 ifrangeF_body7_abs drSR_Y_equality
separation_cong[where P="is_ifrangeF_body7(##M,A,B,D,G,b,f)" and M="##M",THEN iffD1]
unfolding ifrangeF_body7_def if_range_F_def if_range_F_else_F_def ifrFb_body7_def
by simp
end
Theory Proper_Extension
sectionâ¹Separative notions and proper extensionsâº
theory Proper_Extension
imports
Names
begin
textâ¹The key ingredient to obtain a proper extension is to have
a ââ¹separative preorderâº:âº
locale separative_notion = forcing_notion +
assumes separative: "pâP â¹ âqâP. ârâP. q â¼ p â§ r â¼ p â§ q ⥠r"
begin
textâ¹For separative preorders, the complement of every filter is
dense. Hence an $M$-generic filter cannot belong to the ground model.âº
lemma filter_complement_dense:
assumes "filter(G)"
shows "dense(P - G)"
proof
fix p
assume "pâP"
show "âdâP - G. d â¼ p"
proof (cases "pâG")
case True
note â¹pâP⺠assms
moreover
obtain q r where "q â¼ p" "r â¼ p" "q ⥠r" "qâP" "râP"
using separative[OF â¹pâPâº]
by force
with â¹filter(G)âº
obtain s where "s â¼ p" "s â G" "s â P"
using filter_imp_compat[of G q r]
by auto
then
show ?thesis
by blast
next
case False
with â¹pâPâº
show ?thesis
using refl_leq unfolding Diff_def by auto
qed
qed
end
locale ctm_separative = forcing_data1 + separative_notion
begin
lemma generic_not_in_M:
assumes "M_generic(G)"
shows "G â M"
proof
assume "GâM"
then
have "P - G â M"
using P_in_M Diff_closed by simp
moreover
have "¬(âqâG. q â P - G)" "(P - G) â P"
unfolding Diff_def by auto
moreover
note assms
ultimately
show "False"
using filter_complement_dense[of G] M_generic_denseD[of G "P-G"]
M_generic_def by simp
qed
theorem proper_extension:
assumes "M_generic(G)"
shows "M â M[G]"
using assms G_in_Gen_Ext[of G] one_in_G[of G] generic_not_in_M
by force
end
end
Theory Succession_Poset
sectionâ¹A poset of successionsâº
theory Succession_Poset
imports
Replacement_Instances
Proper_Extension
begin
textâ¹In this theory we define a separative poset. Its underlying set is the
set of finite binary sequences (that is, with codomain $2={0,1}$);
of course, one can see that set as
the set \<^term>â¹Ï-||>2⺠or equivalently as the set of partial functions
\<^term>â¹Fn(Ï,Ï,2)âº, i.e. the set of partial functions bounded by \<^term>â¹Ïâº.
The order relation of the poset is that of being less defined as functions
(cf. \<^term>â¹Fnlerel(Aâ<Ïâ)âº), so it could be surprising that we have not used
\<^term>â¹Fn(Ï,Ï,2)⺠for the set. The only reason why we keep this alternative
definition is because we can prove \<^term>â¹Aâ<Ïâ â M⺠(and therefore
\<^term>â¹Fnlerel(Aâ<Ïâ) â Mâº) using only one instance of replacement.âº
sublocale M_ZF2_trans â M_seqspace "##M"
by (unfold_locales, simp add:replacement_omega_funspace)
definition seq_upd :: "i â i â i" where
"seq_upd(f,a) ⡠λ j â succ(domain(f)) . if j < domain(f) then f`j else a"
lemma seq_upd_succ_type :
assumes "nânat" "fânâA" "aâA"
shows "seq_upd(f,a)â succ(n) â A"
proof -
from assms
have equ: "domain(f) = n"
using domain_of_fun by simp
{
fix j
assume "jâsucc(domain(f))"
with equ â¹nâ_âº
have "jâ¤n"
using ltI by auto
with â¹nâ_âº
consider (lt) "j<n" | (eq) "j=n"
using leD by auto
then
have "(if j < n then f`j else a) â A"
proof cases
case lt
with â¹fâ_âº
show ?thesis
using apply_type ltD[OF lt] by simp
next
case eq
with â¹aâ_âº
show ?thesis
by auto
qed
}
with equ
show ?thesis
unfolding seq_upd_def
using lam_type[of "succ(domain(f))"]
by auto
qed
lemma seq_upd_type :
assumes "fâAâ<Ïâ" "aâA"
shows "seq_upd(f,a) â Aâ<Ïâ"
proof -
from â¹fâ_âº
obtain y where "yânat" "fâyâA"
unfolding seqspace_def by blast
with â¹aâAâº
have "seq_upd(f,a)âsucc(y)âA"
using seq_upd_succ_type by simp
with â¹yâ_âº
show ?thesis
unfolding seqspace_def by auto
qed
lemma seq_upd_apply_domain [simp]:
assumes "f:nâA" "nânat"
shows "seq_upd(f,a)`n = a"
unfolding seq_upd_def using assms domain_of_fun by auto
lemma zero_in_seqspace :
shows "0 â Aâ<Ïâ"
unfolding seqspace_def
by force
definition
seqlerel :: "i â i" where
"seqlerel(A) â¡ Fnlerel(Aâ<Ïâ)"
definition
seqle :: "i" where
"seqle â¡ seqlerel(2)"
lemma seqleI[intro!]:
"â¨f,gâ© â 2â<ÏâÃ2â<Ïâ â¹ g â f â¹ â¨f,gâ© â seqle"
unfolding seqle_def seqlerel_def seqspace_def Rrel_def Fnlerel_def
by blast
lemma seqleD[dest!]:
"z â seqle â¹ âx y. â¨x,yâ© â 2â<ÏâÃ2â<Ïâ â§ y â x â§ z = â¨x,yâ©"
unfolding Rrel_def seqle_def seqlerel_def Fnlerel_def
by blast
lemma upd_leI :
assumes "fâ2â<Ïâ" "aâ2"
shows "â¨seq_upd(f,a),fâ©âseqle" (is "â¨?f,_â©â_")
proof
show " â¨?f, fâ© â 2â<Ïâ à 2â<Ïâ"
using assms seq_upd_type by auto
next
show "f â seq_upd(f,a)"
proof
fix x
assume "x â f"
moreover from â¹f â 2â<Ïââº
obtain n where "nânat" "f : n â 2"
by blast
moreover from calculation
obtain y where "yân" "x=â¨y,f`yâ©"
using Pi_memberD[of f n "λ_ . 2"]
by blast
moreover from â¹f:nâ2âº
have "domain(f) = n"
using domain_of_fun by simp
ultimately
show "x â seq_upd(f,a)"
unfolding seq_upd_def lam_def
by (auto intro:ltI)
qed
qed
lemma preorder_on_seqle: "preorder_on(2â<Ïâ,seqle)"
unfolding preorder_on_def refl_def trans_on_def by blast
lemma zero_seqle_max: "xâ2â<Ïâ â¹ â¨x,0â© â seqle"
using zero_in_seqspace
by auto
interpretation sp:forcing_notion "2â<Ïâ" "seqle" "0"
using preorder_on_seqle zero_seqle_max zero_in_seqspace
by unfold_locales simp_all
notation sp.Leq (infixl "â¼s" 50)
notation sp.Incompatible (infixl "â¥s" 50)
notation sp.GenExt_at_P ("_âsâ[_]" [71,1])
lemma seqspace_separative:
assumes "fâ2â<Ïâ"
shows "seq_upd(f,0) â¥s seq_upd(f,1)" (is "?f â¥s ?g")
proof
assume "sp.compat(?f, ?g)"
then
obtain h where "h â 2â<Ïâ" "?f â h" "?g â h"
by blast
moreover from â¹fâ_âº
obtain y where "yânat" "f:yâ2"
by blast
moreover from this
have "?f: succ(y) â 2" "?g: succ(y) â 2"
using seq_upd_succ_type by blast+
moreover from this
have "â¨y,?f`yâ© â ?f" "â¨y,?g`yâ© â ?g"
using apply_Pair by auto
ultimately
have "â¨y,0â© â h" "â¨y,1â© â h"
by auto
moreover from â¹h â 2â<Ïââº
obtain n where "nânat" "h:nâ2"
by blast
ultimately
show "False"
using fun_is_function[of h n "λ_. 2"]
unfolding seqspace_def function_def by auto
qed
definition seqleR_fm :: "i â i" where
"seqleR_fm(fg) â¡ Exists(Exists(And(pair_fm(0,1,fg+â©Ï2),subset_fm(1,0))))"
lemma type_seqleR_fm : "fg â nat â¹ seqleR_fm(fg) â formula"
unfolding seqleR_fm_def
by simp
arity_theorem for "seqleR_fm"
lemma (in M_ctm1) seqleR_fm_sats :
assumes "fgânat" "envâlist(M)"
shows "(M, env ⨠seqleR_fm(fg)) â· (âf[##M]. âg[##M]. pair(##M,f,g,nth(fg,env)) â§ f â g)"
unfolding seqleR_fm_def
using assms trans_M sats_subset_fm pair_iff_sats
by auto
locale M_ctm2 = M_ctm1 + M_ZF2_trans
locale M_ctm2_AC = M_ctm2 + M_ZFC2_trans
locale forcing_data2 = forcing_data1 + M_ctm2
context M_ctm2
begin
lemma seqle_in_M: "seqle â M"
using arity_seqleR_fm seqleR_fm_sats type_seqleR_fm
cartprod_closed seqspace_closed nat_into_M nat_in_M pair_in_M_iff
unfolding seqle_def seqlerel_def Rrel_def Fnlerel_def
by (rule_tac Collect_in_M[of "seqleR_fm(0)" "[]"],auto)
subsectionâ¹Cohen extension is properâº
interpretation ctm_separative "2â<Ïâ" seqle 0
proof (unfold_locales)
fix f
let ?q="seq_upd(f,0)" and ?r="seq_upd(f,1)"
assume "f â 2â<Ïâ"
then
have "?q â¼s f â§ ?r â¼s f â§ ?q â¥s ?r"
using upd_leI seqspace_separative by auto
moreover from calculation
have "?q â 2â<Ïâ" "?r â 2â<Ïâ"
using seq_upd_type[of f 2] by auto
ultimately
show "âqâ2â<Ïâ. ârâ2â<Ïâ. q â¼s f â§ r â¼s f â§ q â¥s r"
by (rule_tac bexI)+
next
show "2â<Ïâ â M"
using nat_into_M seqspace_closed by simp
next
show "seqle â M"
using seqle_in_M .
qed
lemma cohen_extension_is_proper: "âG. M_generic(G) â§ M â Mâ2â<Ïââ[G]"
using proper_extension generic_filter_existence zero_in_seqspace
by force
end
end /head>
Theory ZF_Trans_Interpretations
sectionâ¹Further instances of axiom-schemesâº
theory ZF_Trans_Interpretations
imports
Internal_ZFC_Axioms
Succession_Poset
begin
locale M_ZF3 = M_ZF2 +
assumes
replacement_ax3:
"replacement_assm(M,env,replacement_is_order_body_fm)"
"replacement_assm(M,env,wfrec_replacement_order_pred_fm)"
"replacement_assm(M,env,replacement_is_jump_cardinal_body_fm)"
"replacement_assm(M,env,replacement_is_aleph_fm)"
and
LambdaPair_in_M_replacement3:
"replacement_assm(M,env,LambdaPair_in_M_fm(is_inj_fm(0,1,2),0))"
definition instances3_fms where "instances3_fms â¡
{ replacement_is_order_body_fm,
wfrec_replacement_order_pred_fm,
replacement_is_jump_cardinal_body_fm,
replacement_is_aleph_fm,
LambdaPair_in_M_fm(is_inj_fm(0,1,2),0) }"
txtâ¹This set has 5 internalized formulas.âº
lemmas replacement_instances3_defs =
replacement_is_order_body_fm_def wfrec_replacement_order_pred_fm_def
replacement_is_jump_cardinal_body_fm_def
replacement_is_aleph_fm_def
declare (in M_ZF3) replacement_instances3_defs [simp]
locale M_ZF3_trans = M_ZF2_trans + M_ZF3
locale M_ZFC3 = M_ZFC2 + M_ZF3
locale M_ZFC3_trans = M_ZFC2_trans + M_ZF3_trans
locale M_ctm3 = M_ctm2 + M_ZF3_trans + M_ZF2_trans
locale M_ctm3_AC = M_ctm3 + M_ctm1_AC + M_ZFC3_trans
locale forcing_data3 = forcing_data2 + M_ctm3_AC
lemmas (in M_ZF2_trans) separation_instances =
separation_well_ord
separation_obase_equals separation_is_obase
separation_PiP_rel separation_surjP_rel
separation_radd_body separation_rmult_body
lemma (in M_ZF3_trans) lam_replacement_inj_rel:
shows
"lam_replacement(##M, λp. injâ##Mâ(fst(p),snd(p)))"
using lam_replacement_iff_lam_closed[THEN iffD2,of "λp. injâMâ(fst(p),snd(p))"]
LambdaPair_in_M[where Ï="is_inj_fm(0,1,2)" and is_f="is_inj(##M)" and env="[]",OF
is_inj_fm_type _ is_inj_iff_sats[symmetric] inj_rel_iff,simplified]
arity_is_inj_fm[of 0 1 2] ord_simp_union transitivity fst_snd_closed
inj_rel_closed zero_in_M LambdaPair_in_M_replacement3
by simp
arity_theorem for "is_transitive_fm"
arity_theorem for "is_linear_fm"
arity_theorem for "is_wellfounded_on_fm"
arity_theorem for "is_well_ord_fm"
arity_theorem for "pred_set_fm"
arity_theorem for "image_fm"
definition omap_wfrec_body where
"omap_wfrec_body(A,r) â¡ (â
ââ
image_fm(2, 0, 1) â§
pred_set_fm
(succ(succ(succ(succ(succ(succ(succ(succ(succ(A))))))))), 3,
succ(succ(succ(succ(succ(succ(succ(succ(succ(r))))))))), 0) â
â
)"
lemma type_omap_wfrec_body_fm :"Aânat â¹ rânat â¹ omap_wfrec_body(A,r)âformula"
unfolding omap_wfrec_body_def by simp
lemma arity_aux : "Aânat â¹ rânat â¹ arity(omap_wfrec_body(A,r)) = (9+â©ÏA) ⪠(9+â©Ïr)"
unfolding omap_wfrec_body_def
using arity_image_fm arity_pred_set_fm pred_Un_distrib union_abs2[of 3] union_abs1
by (simp add:FOL_arities, auto simp add:Un_assoc[symmetric] union_abs1)
lemma arity_omap_wfrec: "Aânat â¹ rânat â¹
arity(is_wfrec_fm(omap_wfrec_body(A,r),succ(succ(succ(r))), 1, 0)) =
(4+â©ÏA) ⪠(4+â©Ïr)"
using Arities.arity_is_wfrec_fm[OF _ _ _ _ _ arity_aux,of A r "3+â©Ïr" 1 0] pred_Un_distrib
union_abs1 union_abs2 type_omap_wfrec_body_fm
by auto
lemma arity_isordermap: "Aânat â¹ rânat â¹dânatâ¹
arity(is_ordermap_fm(A,r,d)) = succ(d) ⪠(succ(A) ⪠succ(r))"
unfolding is_ordermap_fm_def
using arity_lambda_fm[where i="(4+â©ÏA) ⪠(4+â©Ïr)",OF _ _ _ _ arity_omap_wfrec,
unfolded omap_wfrec_body_def] pred_Un_distrib union_abs1
by auto
lemma arity_is_ordertype: "Aânat â¹ rânat â¹dânatâ¹
arity(is_ordertype_fm(A,r,d)) = succ(d) ⪠(succ(A) ⪠succ(r))"
unfolding is_ordertype_fm_def
using arity_isordermap arity_image_fm pred_Un_distrib FOL_arities
by auto
arity_theorem for "is_order_body_fm"
lemma arity_is_order_body: "arity(is_order_body_fm(2,0,1)) = 3"
using arity_is_order_body_fm arity_is_ordertype ord_simp_union
by (simp add:FOL_arities)
lemma (in M_ZF3_trans) replacement_is_order_body:
"XâM â¹ strong_replacement(##M, is_order_body(##M,X))"
apply(rule_tac strong_replacement_cong[
where P="λ x f. M,[x,f,X] ⨠is_order_body_fm(2,0,1)",THEN iffD1])
apply(rule_tac is_order_body_iff_sats[where env="[_,_,X]",symmetric])
apply(simp_all add:zero_in_M)
apply(rule_tac replacement_ax3(1)[unfolded replacement_assm_def, rule_format, where env="[X]",simplified])
apply(simp_all add: arity_is_order_body )
done
lemma (in M_pre_cardinal_arith) is_order_body_abs :
"M(X) â¹ M(x) â¹ M(z) â¹ is_order_body(M, X, x, z) â·
M(z) â§ M(x) â§ xâPow_rel(M,XÃX) â§ well_ord(X, x) â§ z = ordertype(X, x)"
using well_ord_abs is_well_ord_iff_wellordered is_ordertype_iff' ordertype_rel_abs
well_ord_is_linear subset_abs Pow_rel_char
unfolding is_order_body_def
by simp
definition H_order_pred where
"H_order_pred(A,r) ⡠λx f . f `` Order.pred(A, x, r)"
relationalize "H_order_pred" "is_H_order_pred"
lemma (in M_basic) H_order_pred_abs :
"M(A) â¹ M(r) â¹ M(x) â¹ M(f) â¹ M(z) â¹
is_H_order_pred(M,A,r,x,f,z) â· z = H_order_pred(A,r,x,f)"
unfolding is_H_order_pred_def H_order_pred_def
by simp
synthesize "is_H_order_pred" from_definition assuming "nonempty"
lemma (in M_ZF3_trans) wfrec_replacement_order_pred:
"AâM â¹ râM â¹ wfrec_replacement(##M, λx g z. is_H_order_pred(##M,A,r,x,g,z) , r)"
unfolding wfrec_replacement_def is_wfrec_def M_is_recfun_def is_H_order_pred_def
apply(rule_tac strong_replacement_cong[
where P="λ x f. M,[x,f,r,A] ⨠order_pred_wfrec_body_fm(3,2,1,0)",THEN iffD1])
apply(subst order_pred_wfrec_body_def[symmetric])
apply(rule_tac order_pred_wfrec_body_iff_sats[where env="[_,_,r,A]",symmetric])
apply(simp_all add:zero_in_M)
apply(rule_tac replacement_ax3(2)[unfolded replacement_assm_def, rule_format, where env="[r,A]",simplified])
apply(simp_all add: arity_order_pred_wfrec_body_fm ord_simp_union)
done
lemma (in M_ZF3_trans) wfrec_replacement_order_pred':
"AâM â¹ râM â¹ wfrec_replacement(##M, λx g z. z = H_order_pred(A,r,x,g) , r)"
using wfrec_replacement_cong[OF H_order_pred_abs[of A r,rule_format] refl,THEN iffD1,
OF _ _ _ _ _ wfrec_replacement_order_pred[of A r]]
by simp
sublocale M_ZF3_trans â M_pre_cardinal_arith "##M"
using separation_instances wfrec_replacement_order_pred'[unfolded H_order_pred_def]
replacement_is_order_eq_map[unfolded order_eq_map_def] banach_replacement
by unfold_locales simp_all
lemma (in M_ZF3_trans) replacement_ordertype:
"XâM â¹ strong_replacement(##M, λx z. z â M â§ x â M â§ x â PowâMâ(X à X) â§ well_ord(X, x) â§ z = ordertype(X, x))"
using strong_replacement_cong[THEN iffD1,OF _ replacement_is_order_body,simplified] is_order_body_abs
unfolding is_order_body_def
by simp
lemma arity_is_jump_cardinal_body: "arity(is_jump_cardinal_body'_fm(0,1)) = 2"
unfolding is_jump_cardinal_body'_fm_def
using arity_is_ordertype arity_is_well_ord_fm arity_is_Pow_fm arity_cartprod_fm
arity_Replace_fm[where i=5] ord_simp_union FOL_arities
by simp
lemma (in M_ZF3_trans) replacement_is_jump_cardinal_body:
"strong_replacement(##M, is_jump_cardinal_body'(##M))"
apply(rule_tac strong_replacement_cong[
where P="λ x f. M,[x,f] ⨠is_jump_cardinal_body'_fm(0,1)",THEN iffD1])
apply(rule_tac is_jump_cardinal_body'_iff_sats[where env="[_,_]",symmetric])
apply(simp_all add:zero_in_M)
apply(rule_tac replacement_ax3(3)[unfolded replacement_assm_def, rule_format, where env="[]",simplified])
apply(simp_all add: arity_is_jump_cardinal_body )
done
lemma (in M_pre_cardinal_arith) univalent_aux2: "M(X) â¹ univalent(M,Pow_rel(M,XÃX),
λr z. M(z) ⧠M(r) ⧠is_well_ord(M, X, r) ⧠is_ordertype(M, X, r, z))"
using is_well_ord_iff_wellordered
is_ordertype_iff[of _ X]
trans_on_subset[OF well_ord_is_trans_on]
well_ord_is_wf[THEN wf_on_subset_A] mem_Pow_rel_abs
unfolding univalent_def
by (simp)
lemma (in M_pre_cardinal_arith) is_jump_cardinal_body_abs :
"M(X) â¹ M(c) â¹ is_jump_cardinal_body'(M, X, c) â· c = jump_cardinal_body'_rel(M,X)"
using well_ord_abs is_well_ord_iff_wellordered is_ordertype_iff' ordertype_rel_abs
well_ord_is_linear subset_abs Pow_rel_iff Replace_abs[of "Pow_rel(M,XÃX)",OF _ _
univalent_aux2]
unfolding is_jump_cardinal_body'_def jump_cardinal_body'_rel_def
by simp
lemma (in M_ZF3_trans) replacement_jump_cardinal_body:
"strong_replacement(##M, λx z. z â M â§ x â M â§ z = jump_cardinal_body(##M, x))"
using strong_replacement_cong[THEN iffD1,OF _ replacement_is_jump_cardinal_body,simplified]
jump_cardinal_body_eq is_jump_cardinal_body_abs
by simp
sublocale M_ZF3_trans â M_pre_aleph "##M"
using replacement_ordertype replacement_jump_cardinal_body HAleph_wfrec_repl
by unfold_locales (simp_all add: transrec_replacement_def
wfrec_replacement_def is_wfrec_def M_is_recfun_def flip:setclass_iff)
arity_theorem intermediate for "is_HAleph_fm"
lemma arity_is_HAleph_fm: "arity(is_HAleph_fm(2, 1, 0)) = 3"
using arity_fun_apply_fm[of "11" 0 1,simplified]
arity_is_HAleph_fm' arity_ordinal_fm arity_is_If_fm
arity_empty_fm arity_is_Limit_fm
arity_is_If_fm
arity_is_Limit_fm arity_empty_fm
arity_Replace_fm[where i="12" and v=10 and n=3]
pred_Un_distrib ord_simp_union
by (simp add:FOL_arities)
lemma arity_is_Aleph: "arity(is_Aleph_fm(0, 1)) = 2"
unfolding is_Aleph_fm_def
using arity_transrec_fm[OF _ _ _ _ arity_is_HAleph_fm] ord_simp_union
by simp
lemma (in M_ZF3_trans) replacement_is_aleph:
"strong_replacement(##M, λx y. Ord(x) ⧠is_Aleph(##M,x,y))"
apply(rule_tac strong_replacement_cong[
where P="λ x y. M,[x,y] ⨠And(ordinal_fm(0),is_Aleph_fm(0,1))",THEN iffD1])
apply (auto simp add: ordinal_iff_sats[where env="[_,_]",symmetric])
apply(rule_tac is_Aleph_iff_sats[where env="[_,_]",THEN iffD2],simp_all add:zero_in_M)
apply(rule_tac is_Aleph_iff_sats[where env="[_,_]",THEN iffD1],simp_all add:zero_in_M)
apply(rule_tac replacement_ax3(4)[unfolded replacement_assm_def, rule_format, where env="[]",simplified])
apply(simp_all add:arity_is_Aleph FOL_arities arity_ordinal_fm ord_simp_union is_Aleph_fm_type)
done
lemma (in M_ZF3_trans) replacement_aleph_rel:
shows "strong_replacement(##M, λx y. Ord(x) â§ y = âµâxââMâ)"
using strong_replacement_cong[THEN iffD2,OF _ replacement_is_aleph,where P1="λx y . Ord(x) ⧠y=Aleph_rel(##M,x)"]
is_Aleph_iff
by auto
sublocale M_ZF3_trans â M_aleph "##M"
by (unfold_locales,simp add: replacement_aleph_rel)
sublocale M_ZF2_trans â M_FiniteFun "##M"
using separation_cons_like_rel separation_is_function
by unfold_locales simp
sublocale M_ZFC1_trans â M_AC "##M"
using choice_ax by (unfold_locales, simp_all)
sublocale M_ZFC3_trans â M_cardinal_AC "##M" ..
lemma (in M_ZF2_trans) separation_cardinal_rel_lesspoll_rel:
"(##M)(κ) â¹ separation(##M, λx. x âºâMâ κ)"
using separation_in_ctm[where Ï="( â
0 ⺠1â
)" and env="[κ]"]
is_lesspoll_iff nonempty
arity_is_cardinal_fm arity_is_lesspoll_fm arity_is_bij_fm ord_simp_union
by (simp add:FOL_arities)
sublocale M_ZFC3_trans â M_library "##M"
using separation_cardinal_rel_lesspoll_rel
by unfold_locales simp_all
locale M_ZF4 = M_ZF3 +
assumes
ground_replacements4:
"ground_replacement_assm(M,env,replacement_is_order_body_fm)"
"ground_replacement_assm(M,env,wfrec_replacement_order_pred_fm)"
"ground_replacement_assm(M,env,replacement_is_jump_cardinal_body_fm)"
"ground_replacement_assm(M,env,replacement_is_aleph_fm)"
"ground_replacement_assm(M,env,LambdaPair_in_M_fm(is_inj_fm(0,1,2),0))"
"ground_replacement_assm(M,env,wfrec_Hfrc_at_fm)"
"ground_replacement_assm(M,env,list_repl1_intf_fm)"
"ground_replacement_assm(M,env,list_repl2_intf_fm)"
"ground_replacement_assm(M,env,formula_repl2_intf_fm)"
"ground_replacement_assm(M,env,eclose_repl2_intf_fm)"
"ground_replacement_assm(M,env,powapply_repl_fm)"
"ground_replacement_assm(M,env,phrank_repl_fm)"
"ground_replacement_assm(M,env,wfrec_rank_fm)"
"ground_replacement_assm(M,env,trans_repl_HVFrom_fm)"
"ground_replacement_assm(M,env,wfrec_Hcheck_fm)"
"ground_replacement_assm(M,env,repl_PHcheck_fm)"
"ground_replacement_assm(M,env,check_replacement_fm)"
"ground_replacement_assm(M,env,G_dot_in_M_fm)"
"ground_replacement_assm(M,env,repl_opname_check_fm)"
"ground_replacement_assm(M,env,tl_repl_intf_fm)"
"ground_replacement_assm(M,env,formula_repl1_intf_fm)"
"ground_replacement_assm(M,env,eclose_repl1_intf_fm)"
"ground_replacement_assm(M,env,replacement_is_omega_funspace_fm)"
"ground_replacement_assm(M,env,replacement_HAleph_wfrec_repl_body_fm)"
"ground_replacement_assm(M,env,replacement_is_fst2_snd2_fm)"
"ground_replacement_assm(M,env,replacement_is_sndfst_fst2_snd2_fm)"
"ground_replacement_assm(M,env,replacement_is_order_eq_map_fm)"
"ground_replacement_assm(M,env,replacement_transrec_apply_image_body_fm)"
"ground_replacement_assm(M,env,banach_replacement_iterates_fm)"
"ground_replacement_assm(M,env,replacement_is_trans_apply_image_fm)"
"ground_replacement_assm(M,env,banach_iterates_fm)"
"ground_replacement_assm(M,env,dcwit_repl_body_fm(6,5,4,3,2,0,1))"
"ground_replacement_assm(M,env,Lambda_in_M_fm(fst_fm(0,1),0))"
"ground_replacement_assm(M,env,Lambda_in_M_fm(big_union_fm(0,1),0))"
"ground_replacement_assm(M,env,Lambda_in_M_fm(is_cardinal_fm(0,1),0))"
"ground_replacement_assm(M,env,Lambda_in_M_fm(snd_fm(0,1),0))"
"ground_replacement_assm(M,env,LambdaPair_in_M_fm(image_fm(0,1,2),0))"
"ground_replacement_assm(M,env,LambdaPair_in_M_fm(setdiff_fm(0,1,2),0))"
"ground_replacement_assm(M,env,LambdaPair_in_M_fm(minimum_fm(0,1,2),0))"
"ground_replacement_assm(M,env,LambdaPair_in_M_fm(upair_fm(0,1,2),0))"
"ground_replacement_assm(M,env,LambdaPair_in_M_fm(is_RepFun_body_fm(0,1,2),0))"
"ground_replacement_assm(M,env,LambdaPair_in_M_fm(composition_fm(0,1,2),0))"
"ground_replacement_assm(M,env,Lambda_in_M_fm(is_converse_fm(0,1),0))"
"ground_replacement_assm(M,env,Lambda_in_M_fm(domain_fm(0,1),0))"
definition instances4_fms where "instances4_fms â¡
{ ground_repl_fm(replacement_is_order_body_fm),
ground_repl_fm(wfrec_replacement_order_pred_fm),
ground_repl_fm(replacement_is_jump_cardinal_body_fm),
ground_repl_fm(replacement_is_aleph_fm),
ground_repl_fm(LambdaPair_in_M_fm(is_inj_fm(0,1,2),0)),
ground_repl_fm(wfrec_Hfrc_at_fm),
ground_repl_fm(list_repl1_intf_fm),
ground_repl_fm(list_repl2_intf_fm),
ground_repl_fm(formula_repl2_intf_fm),
ground_repl_fm(eclose_repl2_intf_fm),
ground_repl_fm(powapply_repl_fm),
ground_repl_fm(phrank_repl_fm),
ground_repl_fm(wfrec_rank_fm),
ground_repl_fm(trans_repl_HVFrom_fm),
ground_repl_fm(wfrec_Hcheck_fm),
ground_repl_fm(repl_PHcheck_fm),
ground_repl_fm(check_replacement_fm),
ground_repl_fm(G_dot_in_M_fm),
ground_repl_fm(repl_opname_check_fm),
ground_repl_fm(tl_repl_intf_fm),
ground_repl_fm(formula_repl1_intf_fm),
ground_repl_fm(eclose_repl1_intf_fm),
ground_repl_fm(replacement_is_omega_funspace_fm),
ground_repl_fm(replacement_HAleph_wfrec_repl_body_fm),
ground_repl_fm(replacement_is_fst2_snd2_fm),
ground_repl_fm(replacement_is_sndfst_fst2_snd2_fm),
ground_repl_fm(replacement_is_order_eq_map_fm),
ground_repl_fm(replacement_transrec_apply_image_body_fm),
ground_repl_fm(banach_replacement_iterates_fm),
ground_repl_fm(replacement_is_trans_apply_image_fm),
ground_repl_fm(banach_iterates_fm),
ground_repl_fm(dcwit_repl_body_fm(6,5,4,3,2,0,1)),
ground_repl_fm(Lambda_in_M_fm(fst_fm(0,1),0)),
ground_repl_fm(Lambda_in_M_fm(big_union_fm(0,1),0)),
ground_repl_fm(Lambda_in_M_fm(is_cardinal_fm(0,1),0)),
ground_repl_fm(Lambda_in_M_fm(snd_fm(0,1),0)),
ground_repl_fm(LambdaPair_in_M_fm(image_fm(0,1,2),0)),
ground_repl_fm(LambdaPair_in_M_fm(setdiff_fm(0,1,2),0)),
ground_repl_fm(LambdaPair_in_M_fm(minimum_fm(0,1,2),0)),
ground_repl_fm(LambdaPair_in_M_fm(upair_fm(0,1,2),0)),
ground_repl_fm(LambdaPair_in_M_fm(is_RepFun_body_fm(0,1,2),0)),
ground_repl_fm(LambdaPair_in_M_fm(composition_fm(0,1,2),0)),
ground_repl_fm(Lambda_in_M_fm(is_converse_fm(0,1),0)),
ground_repl_fm(Lambda_in_M_fm(domain_fm(0,1),0)) }"
txtâ¹This set has 44 internalized formulas, corresponding to the total count
of previous replacement instances.âº
definition overhead where
"overhead ⡠instances1_fms ⪠instances2_fms ⪠instances3_fms ⪠instances4_fms"
txtâ¹Hence, the âoverheadâ to force $\CH$ and its negation consists
of 88 replacement instances.âº
lemma instances3_fms_type[TC] : "instances3_fms â formula"
unfolding instances3_fms_def replacement_is_order_body_fm_def
wfrec_replacement_order_pred_fm_def replacement_is_jump_cardinal_body_fm_def
replacement_is_aleph_fm_def
by (auto simp del: Lambda_in_M_fm_def
ccc_fun_closed_lemma_aux2_fm_def ccc_fun_closed_lemma_fm_def)
lemma overhead_type: "overhead â formula"
using instances1_fms_type instances2_fms_type
unfolding overhead_def instances3_fms_def instances4_fms_def
replacement_instances1_defs replacement_instances2_defs replacement_instances3_defs
using ground_repl_fm_type Lambda_in_M_fm_type
by (auto simp del: Lambda_in_M_fm_def
ccc_fun_closed_lemma_aux2_fm_def ccc_fun_closed_lemma_fm_def)
locale M_ZF4_trans = M_ZF3_trans + M_ZF4
locale M_ZFC4 = M_ZFC3 + M_ZF4
locale M_ZFC4_trans = M_ZFC3_trans + M_ZF4_trans
locale M_ctm4 = M_ctm3 + M_ZF4_trans
locale M_ctm4_AC = M_ctm4 + M_ctm1_AC + M_ZFC4_trans
locale forcing_data4 = forcing_data3 + M_ctm4_AC
lemma M_satT_imp_M_ZF2: "(M ⨠ZF) ⹠M_ZF2(M)"
proof -
assume "M ⨠ZF"
then
have fin: "upair_ax(##M)" "Union_ax(##M)" "power_ax(##M)"
"extensionality(##M)" "foundation_ax(##M)" "infinity_ax(##M)"
unfolding ZF_def ZF_fin_def ZFC_fm_defs satT_def
using ZFC_fm_sats[of M] by simp_all
{
fix Ï env
assume "Ï â formula" "envâlist(M)"
moreover from â¹M ⨠ZFâº
have "âpâformula. (M, [] ⨠(ZF_separation_fm(p)))"
"âpâformula. (M, [] ⨠(ZF_replacement_fm(p)))"
unfolding ZF_def ZF_schemes_def by auto
moreover from calculation
have "arity(Ï) ⤠succ(length(env)) â¹ separation(##M, λx. (M, Cons(x, env) ⨠Ï))"
"arity(Ï) ⤠succ(succ(length(env))) â¹ strong_replacement(##M,λx y. sats(M,Ï,Cons(x,Cons(y, env))))"
using sats_ZF_separation_fm_iff sats_ZF_replacement_fm_iff by simp_all
}
with fin
show "M_ZF2(M)"
by unfold_locales (simp_all add:replacement_assm_def ground_replacement_assm_def)
qed
lemma M_satT_imp_M_ZFC2:
shows "(M ⨠ZFC) ⶠM_ZFC2(M)"
proof -
have "(M ⨠ZF) ⧠choice_ax(##M) ⶠM_ZFC2(M)"
using M_satT_imp_M_ZF2[of M] unfolding M_ZF2_def M_ZFC1_def M_ZFC2_def
M_ZC_basic_def M_ZF1_def M_AC_def by auto
then
show ?thesis
unfolding ZFC_def by auto
qed
lemma M_satT_instances12_imp_M_ZF2:
assumes "(M ⨠â
Zâ
⪠{â
Replacement(p)â
. p â instances1_fms ⪠instances2_fms})"
shows "M_ZF2(M)"
proof -
from assms
have fin: "upair_ax(##M)" "Union_ax(##M)" "power_ax(##M)"
"extensionality(##M)" "foundation_ax(##M)" "infinity_ax(##M)"
unfolding ZF_fin_def Zermelo_fms_def ZFC_fm_defs satT_def
using ZFC_fm_sats[of M] by simp_all
moreover
{
fix Ï env
from â¹M ⨠â
Zâ
⪠{â
Replacement(p)â
. p â instances1_fms ⪠instances2_fms}âº
have "âpâformula. (M, [] ⨠(ZF_separation_fm(p)))"
unfolding Zermelo_fms_def ZF_def instances1_fms_def
instances2_fms_def by auto
moreover
assume "Ï â formula" "envâlist(M)"
ultimately
have "arity(Ï) ⤠succ(length(env)) â¹ separation(##M, λx. (M, Cons(x, env) ⨠Ï))"
using sats_ZF_separation_fm_iff by simp_all
}
moreover
{
fix Ï env
assume "Ï â instances1_fms ⪠instances2_fms" "envâlist(M)"
moreover from this and â¹M ⨠â
Zâ
⪠{â
Replacement(p)â
. p â instances1_fms ⪠instances2_fms}âº
have "M, [] ⨠â
Replacement(Ï)â
" by auto
ultimately
have "arity(Ï) ⤠succ(succ(length(env))) â¹ strong_replacement(##M,λx y. sats(M,Ï,Cons(x,Cons(y, env))))"
using sats_ZF_replacement_fm_iff[of Ï] instances1_fms_type instances2_fms_type by auto
}
ultimately
show ?thesis
unfolding instances1_fms_def instances2_fms_def
by unfold_locales (simp_all add:replacement_assm_def ground_replacement_assm_def)
qed
lemma (in M_Z_basic) M_satT_Zermelo_fms: "M ⨠â
Zâ
"
using upair_ax Union_ax power_ax extensionality foundation_ax
infinity_ax separation_ax sats_ZF_separation_fm_iff
unfolding Zermelo_fms_def ZF_fin_def
by auto
lemma (in M_ZFC1) M_satT_ZC: "M ⨠ZC"
using upair_ax Union_ax power_ax extensionality foundation_ax
infinity_ax separation_ax sats_ZF_separation_fm_iff choice_ax
unfolding ZC_def Zermelo_fms_def ZF_fin_def
by auto
locale M_ZF = M_Z_basic +
assumes
replacement_ax:"replacement_assm(M,env,Ï)"
lemma M_satT_imp_M_ZF: " M ⨠ZF ⹠M_ZF(M)"
proof -
assume "M ⨠ZF"
then
have fin: "upair_ax(##M)" "Union_ax(##M)" "power_ax(##M)"
"extensionality(##M)" "foundation_ax(##M)" "infinity_ax(##M)"
unfolding ZF_def ZF_fin_def ZFC_fm_defs satT_def
using ZFC_fm_sats[of M] by simp_all
{
fix Ï env
assume "Ï â formula" "envâlist(M)"
moreover from â¹M ⨠ZFâº
have "âpâformula. (M, [] ⨠(ZF_separation_fm(p)))"
"âpâformula. (M, [] ⨠(ZF_replacement_fm(p)))"
unfolding ZF_def ZF_schemes_def by auto
moreover from calculation
have "arity(Ï) ⤠succ(length(env)) â¹ separation(##M, λx. (M, Cons(x, env) ⨠Ï))"
"arity(Ï) ⤠succ(succ(length(env))) â¹ strong_replacement(##M,λx y. sats(M,Ï,Cons(x,Cons(y, env))))"
using sats_ZF_separation_fm_iff sats_ZF_replacement_fm_iff by simp_all
}
with fin
show "M_ZF(M)"
unfolding M_ZF_def M_Z_basic_def M_ZF_axioms_def replacement_assm_def by simp
qed
lemma (in M_ZF) M_satT_ZF: "M ⨠ZF"
using upair_ax Union_ax power_ax extensionality foundation_ax
infinity_ax separation_ax sats_ZF_separation_fm_iff
replacement_ax sats_ZF_replacement_fm_iff
unfolding ZF_def ZF_schemes_def ZF_fin_def replacement_assm_def
by auto
lemma M_ZF_iff_M_satT: "M_ZF(M) ⷠ(M ⨠ZF)"
using M_ZF.M_satT_ZF M_satT_imp_M_ZF
by auto
locale M_ZFC = M_ZF + M_ZC_basic
lemma M_ZFC_iff_M_satT:
notes iff_trans[trans]
shows "M_ZFC(M) ⷠ(M ⨠ZFC)"
proof -
have "M_ZFC(M) ⷠ(M ⨠ZF) ⧠choice_ax(##M)"
using M_ZF_iff_M_satT
unfolding M_ZFC_def M_ZC_basic_def M_AC_def M_ZF_def by auto
also
have " ⦠ⷠM ⨠ZFC"
unfolding ZFC_def by auto
ultimately
show ?thesis by simp
qed
lemma M_satT_imp_M_ZF4: "(M ⨠ZF) ⶠM_ZF4(M)"
proof
assume "M ⨠ZF"
then
have fin: "upair_ax(##M)" "Union_ax(##M)" "power_ax(##M)"
"extensionality(##M)" "foundation_ax(##M)" "infinity_ax(##M)"
unfolding ZF_def ZF_fin_def ZFC_fm_defs satT_def
using ZFC_fm_sats[of M] by simp_all
{
fix Ï env
assume "Ï â formula" "envâlist(M)"
moreover from â¹M ⨠ZFâº
have "âpâformula. (M, [] ⨠(ZF_separation_fm(p)))"
"âpâformula. (M, [] ⨠(ZF_replacement_fm(p)))"
unfolding ZF_def ZF_schemes_def by auto
moreover from calculation
have "arity(Ï) ⤠succ(length(env)) â¹ separation(##M, λx. (M, Cons(x, env) ⨠Ï))"
"arity(Ï) ⤠succ(succ(length(env))) â¹ strong_replacement(##M,λx y. sats(M,Ï,Cons(x,Cons(y, env))))"
using sats_ZF_separation_fm_iff sats_ZF_replacement_fm_iff by simp_all
}
with fin
show "M_ZF4(M)"
by unfold_locales (simp_all add:replacement_assm_def ground_replacement_assm_def)
qed
lemma M_satT_imp_M_ZFC4:
shows "(M ⨠ZFC) ⶠM_ZFC4(M)"
proof -
have "(M ⨠ZF) ⧠choice_ax(##M) ⶠM_ZFC4(M)"
using M_satT_imp_M_ZF4[of M] unfolding M_ZF4_def M_ZFC1_def M_ZFC4_def
M_ZF3_def M_ZFC3_def M_ZF2_def M_ZFC2_def
M_ZC_basic_def M_ZF1_def M_AC_def by auto
then
show ?thesis
unfolding ZFC_def by auto
qed
lemma M_satT_overhead_imp_M_ZF4:
"(M ⨠ZC ⪠{â
Replacement(p)â
. p â overhead}) â¶ M_ZFC4(M)"
proof
assume "M ⨠ZC ⪠{â
Replacement(p)â
. p â overhead}"
then
have fin: "upair_ax(##M)" "Union_ax(##M)" "power_ax(##M)" "choice_ax(##M)"
"extensionality(##M)" "foundation_ax(##M)" "infinity_ax(##M)"
unfolding ZC_def ZF_fin_def Zermelo_fms_def ZFC_fm_defs satT_def
using ZFC_fm_sats[of M] by simp_all
moreover
{
fix Ï env
from â¹M ⨠ZC ⪠{â
Replacement(p)â
. p â overhead}âº
have "âpâformula. (M, [] ⨠(ZF_separation_fm(p)))"
unfolding ZC_def Zermelo_fms_def ZF_def overhead_def instances1_fms_def
instances2_fms_def instances3_fms_def instances4_fms_def by auto
moreover
assume "Ï â formula" "envâlist(M)"
ultimately
have "arity(Ï) ⤠succ(length(env)) â¹ separation(##M, λx. (M, Cons(x, env) ⨠Ï))"
using sats_ZF_separation_fm_iff by simp_all
}
moreover
{
fix Ï env
assume "Ï â overhead" "envâlist(M)"
moreover from this and â¹M ⨠ZC ⪠{â
Replacement(p)â
. p â overhead}âº
have "M, [] ⨠â
Replacement(Ï)â
" by auto
ultimately
have "arity(Ï) ⤠succ(succ(length(env))) â¹ strong_replacement(##M,λx y. sats(M,Ï,Cons(x,Cons(y, env))))"
using sats_ZF_replacement_fm_iff[of Ï] overhead_type by auto
}
ultimately
show "M_ZFC4(M)"
unfolding overhead_def instances1_fms_def
instances2_fms_def instances3_fms_def instances4_fms_def
by unfold_locales (simp_all add:replacement_assm_def ground_replacement_assm_def)
qed
enddy>
Theory Forcing_Main
sectionâ¹The main theoremâº
theory Forcing_Main
imports
Ordinals_In_MG
Choice_Axiom
ZF_Trans_Interpretations
begin
subsectionâ¹The generic extension is countableâº
lemma (in forcing_data1) surj_nat_MG : "âf. f â surj(Ï,M[G])"
proof -
let ?f="λnâÏ. val(P,G,enum`n)"
have "x â Ï â¹ val(P,G, enum ` x)â M[G]" for x
using GenExt_iff[THEN iffD2, of _ G] bij_is_fun[OF M_countable] by force
then
have "?f: Ï â M[G]"
using lam_type[of Ï "λn. val(P,G,enum`n)" "λ_.M[G]"] by simp
moreover
have "ânâÏ. ?f`n = x" if "xâM[G]" for x
using that GenExt_iff[of _ G] bij_is_surj[OF M_countable]
unfolding surj_def by auto
ultimately
show ?thesis
unfolding surj_def by blast
qed
lemma (in G_generic1) MG_eqpoll_nat: "M[G] â Ï"
proof -
obtain f where "f â surj(Ï,M[G])"
using surj_nat_MG by blast
then
have "M[G] â² Ï"
using well_ord_surj_imp_lepoll well_ord_Memrel[of Ï] by simp
moreover
have "Ï â² M[G]"
using ext.nat_into_M subset_imp_lepoll by (auto del:lepollI)
ultimately
show ?thesis
using eqpollI by simp
qed
subsectionâ¹Extensions of ctms of fragments of $\ZFC$âº
lemma M_satT_imp_M_ZF2: "(M ⨠ZF) ⹠M_ZF2(M)"
proof -
assume "M ⨠ZF"
then
have fin: "upair_ax(##M)" "Union_ax(##M)" "power_ax(##M)"
"extensionality(##M)" "foundation_ax(##M)" "infinity_ax(##M)"
unfolding ZF_def ZF_fin_def ZFC_fm_defs satT_def
using ZFC_fm_sats[of M] by simp_all
{
fix Ï env
assume "Ï â formula" "envâlist(M)"
moreover from â¹M ⨠ZFâº
have "âpâformula. (M, [] ⨠(ZF_separation_fm(p)))"
"âpâformula. (M, [] ⨠(ZF_replacement_fm(p)))"
unfolding ZF_def ZF_schemes_def by auto
moreover from calculation
have "arity(Ï) ⤠succ(length(env)) â¹ separation(##M, λx. (M, Cons(x, env) ⨠Ï))"
"arity(Ï) ⤠succ(succ(length(env))) â¹ strong_replacement(##M,λx y. sats(M,Ï,Cons(x,Cons(y, env))))"
using sats_ZF_separation_fm_iff sats_ZF_replacement_fm_iff by simp_all
}
with fin
show "M_ZF2(M)"
by unfold_locales (simp_all add:replacement_assm_def ground_replacement_assm_def)
qed
lemma M_satT_imp_M_ZFC2:
shows "(M ⨠ZFC) ⶠM_ZFC2(M)"
proof -
have "(M ⨠ZF) ⧠choice_ax(##M) ⶠM_ZFC2(M)"
using M_satT_imp_M_ZF2[of M] unfolding M_ZF2_def M_ZFC1_def M_ZFC2_def
M_ZC_basic_def M_ZF1_def M_AC_def by auto
then
show ?thesis
unfolding ZFC_def by auto
qed
lemma M_satT_instances12_imp_M_ZF2:
assumes "(M ⨠â
Zâ
⪠{â
Replacement(p)â
. p â instances1_fms ⪠instances2_fms})"
shows "M_ZF2(M)"
proof -
from assms
have fin: "upair_ax(##M)" "Union_ax(##M)" "power_ax(##M)"
"extensionality(##M)" "foundation_ax(##M)" "infinity_ax(##M)"
unfolding ZF_fin_def Zermelo_fms_def ZFC_fm_defs satT_def
using ZFC_fm_sats[of M] by simp_all
moreover
{
fix Ï env
from â¹M ⨠â
Zâ
⪠{â
Replacement(p)â
. p â instances1_fms ⪠instances2_fms}âº
have "âpâformula. (M, [] ⨠(ZF_separation_fm(p)))"
unfolding Zermelo_fms_def ZF_def instances1_fms_def
instances2_fms_def by auto
moreover
assume "Ï â formula" "envâlist(M)"
ultimately
have "arity(Ï) ⤠succ(length(env)) â¹ separation(##M, λx. (M, Cons(x, env) ⨠Ï))"
using sats_ZF_separation_fm_iff by simp_all
}
moreover
{
fix Ï env
assume "Ï â instances1_fms ⪠instances2_fms" "envâlist(M)"
moreover from this and â¹M ⨠â
Zâ
⪠{â
Replacement(p)â
. p â instances1_fms ⪠instances2_fms}âº
have "M, [] ⨠â
Replacement(Ï)â
" by auto
ultimately
have "arity(Ï) ⤠succ(succ(length(env))) â¹ strong_replacement(##M,λx y. sats(M,Ï,Cons(x,Cons(y, env))))"
using sats_ZF_replacement_fm_iff[of Ï] instances1_fms_type instances2_fms_type by auto
}
ultimately
show ?thesis
unfolding instances1_fms_def instances2_fms_def
by unfold_locales (simp_all add:replacement_assm_def ground_replacement_assm_def)
qed
context G_generic1
begin
lemma sats_ground_repl_fm_imp_sats_ZF_replacement_fm:
assumes
"Ïâformula" "M, [] ⨠â
Replacement(ground_repl_fm(Ï))â
"
shows
"M[G], [] ⨠â
Replacement(Ï)â
"
using assms sats_ZF_replacement_fm_iff
by (auto simp:replacement_assm_def ground_replacement_assm_def
intro:strong_replacement_in_MG[simplified])
lemma satT_ground_repl_fm_imp_satT_ZF_replacement_fm:
assumes
"Φ â formula" "M ⨠{ â
Replacement(ground_repl_fm(Ï))â
. Ï â Φ}"
shows
"M[G] ⨠{ â
Replacement(Ï)â
. Ï â Φ}"
using assms sats_ground_repl_fm_imp_sats_ZF_replacement_fm
by auto
end
theorem extensions_of_ctms:
assumes
"M â Ï" "Transset(M)" "M ⨠â
Zâ
⪠{â
Replacement(p)â
. p â instances1_fms ⪠instances2_fms}"
"Φ â formula" "M ⨠{ â
Replacement(ground_repl_fm(Ï))â
. Ï â Φ}"
shows
"âN.
M â N â§ N â Ï â§ Transset(N) â§ Mâ N â§
(âα. Ord(α) â¶ (α â M ⷠα â N)) â§
((M, []⨠â
ACâ
) â¶ N, [] ⨠â
ACâ
) â§ N ⨠â
Zâ
⪠{ â
Replacement(Ï)â
. Ï â Φ}"
proof -
from â¹M ⨠â
Zâ
⪠{â
Replacement(p)â
. p â instances1_fms ⪠instances2_fms}âº
interpret M_ZF2 M
using M_satT_instances12_imp_M_ZF2
by simp
from â¹Transset(M)âº
interpret M_ZF1_trans M
using M_satT_imp_M_ZF2
by unfold_locales
from â¹M â Ïâº
obtain enum where "enum â bij(Ï,M)"
using eqpoll_sym unfolding eqpoll_def by blast
then
interpret M_ctm2 M enum by unfold_locales simp_all
interpret forcing_data1 "2â<Ïâ" seqle 0 M enum
using nat_into_M seqspace_closed seqle_in_M
by unfold_locales simp
obtain G where "M_generic(G)" "M â Mâsâ[G]"
using cohen_extension_is_proper
by blast
txtâ¹Recall that \<^term>â¹Mâsâ[G]⺠denotes the generic extension \<^term>â¹Mâ2â<Ïââ[G]âº
of \<^term>â¹M⺠using the poset of sequences \<^term>â¹2â<Ïââº.âº
then
interpret G_generic1 "2â<Ïâ" seqle 0 _ enum G by unfold_locales
interpret MG: M_Z_basic "Mâsâ[G]"
using generic pairing_in_MG
Union_MG extensionality_in_MG power_in_MG
foundation_in_MG replacement_assm_MG
separation_in_MG infinity_in_MG replacement_ax1
by unfold_locales simp
have "M, []⨠â
ACâ
â¹ Mâsâ[G], [] ⨠â
ACâ
"
proof -
assume "M, [] ⨠â
ACâ
"
then
have "choice_ax(##M)"
unfolding ZF_choice_fm_def using ZF_choice_auto by simp
then
have "choice_ax(##Mâsâ[G])" using choice_in_MG by simp
then
show "Mâsâ[G], [] ⨠â
ACâ
"
using ZF_choice_auto sats_ZFC_iff_sats_ZF_AC
unfolding ZF_choice_fm_def by simp
qed
moreover
note â¹M â Mâsâ[G]⺠â¹M ⨠{ â
Replacement(ground_repl_fm(Ï))â
. Ï â Φ}⺠â¹Î¦ â formulaâº
moreover
have "Transset(Mâsâ[G])" using Transset_MG .
moreover
have "M â Mâsâ[G]" using M_subset_MG[OF one_in_G] generic by simp
ultimately
show ?thesis
using Ord_MG_iff MG_eqpoll_nat ext.M_satT_Zermelo_fms
satT_ground_repl_fm_imp_satT_ZF_replacement_fm[of Φ]
by (rule_tac x="Mâsâ[G]" in exI, auto)
qed
lemma ZF_replacement_instances12_sub_ZF: "{â
Replacement(p)â
. p â instances1_fms ⪠instances2_fms} â ZF"
using instances1_fms_type instances2_fms_type unfolding ZF_def ZF_schemes_def by auto
theorem extensions_of_ctms_ZF:
assumes
"M â Ï" "Transset(M)" "M ⨠ZF"
shows
"âN.
M â N â§ N â Ï â§ Transset(N) â§ N ⨠ZF â§ Mâ N â§
(âα. Ord(α) â¶ (α â M ⷠα â N)) â§
((M, []⨠â
ACâ
) ⶠN ⨠ZFC)"
proof -
from assms
have "âN.
M â N â§ N â Ï â§ Transset(N) â§ Mâ N â§
(âα. Ord(α) â¶ (α â M ⷠα â N)) â§
((M, []⨠â
ACâ
) â¶ N, [] ⨠â
ACâ
) â§ N ⨠â
Zâ
⪠{ â
Replacement(Ï)â
. Ï â formula}"
using extensions_of_ctms[of M formula] satT_ZF_imp_satT_Z[of M]
satT_mono[OF _ ground_repl_fm_sub_ZF, of M]
satT_mono[OF _ ZF_replacement_instances12_sub_ZF, of M]
by (auto simp: satT_Un_iff)
then
obtain N where "N ⨠â
Zâ
⪠{ â
Replacement(Ï)â
. Ï â formula}" "M â N" "N â Ï" "Transset(N)"
"M â N" "(âα. Ord(α) ⶠα â M ⷠα â N)"
"(M, []⨠â
ACâ
) â¶ N, [] ⨠â
ACâ
"
by blast
moreover from â¹N ⨠â
Zâ
⪠{ â
Replacement(Ï)â
. Ï â formula}âº
have "N ⨠ZF"
using satT_Z_ZF_replacement_imp_satT_ZF by auto
moreover from this and â¹(M, []⨠â
ACâ
) â¶ N, [] ⨠â
ACâ
âº
have "(M, []⨠â
ACâ
) ⶠN ⨠ZFC"
using sats_ZFC_iff_sats_ZF_AC by simp
ultimately
show ?thesis
by auto
qed
endad>
Theory Cardinal_Preservation
sectionâ¹Preservation of cardinals in generic extensionsâº
theory Cardinal_Preservation
imports
Forcing_Main
begin
context forcing_notion
begin
definition
antichain :: "iâo" where
"antichain(A) â¡ AâP â§ (âpâA. âqâA. p â q â¶ p ⥠q)"
definition
ccc :: "o" where
"ccc â¡ âA. antichain(A) â¶ |A| ⤠Ï"
end
context forcing_data1
begin
abbreviation
antichain_r' :: "i â o" where
"antichain_r'(A) â¡ antichain_rel(##M,P,leq,A)"
lemma antichain_abs' [absolut]:
"⦠AâM â§ â¹ antichain_r'(A) â· antichain(A)"
unfolding antichain_rel_def antichain_def compat_def
using P_in_M leq_in_M transitivity[of _ A]
by (auto simp add:absolut)
lemma (in forcing_notion) Incompatible_imp_not_eq: "⦠p ⥠q; pâP; qâP â§â¹ p â q"
using refl_leq by blast
lemma inconsistent_imp_incompatible:
assumes "p â© Ï env" "q â© Neg(Ï) env" "pâP" "qâP"
"arity(Ï) ⤠length(env)" "Ï â formula" "env â list(M)"
shows "p ⥠q"
proof
assume "compat(p,q)"
then
obtain d where "d â¼ p" "d â¼ q" "d â P" by blast
moreover
note assms
moreover from calculation
have "d â© Ï env" "d â© Neg(Ï) env"
using strengthening_lemma by simp_all
ultimately
show "False"
using Forces_Neg[of d env Ï] refl_leq P_in_M
by (auto dest:transM; drule_tac bspec; auto dest:transM)
qed
notation check (â¹_â§v⺠[101] 100)
end
locale G_generic2 = G_generic1 + forcing_data2
locale G_generic2_AC = G_generic1_AC + G_generic2 + M_ctm2_AC
locale G_generic3 = G_generic2 + forcing_data3
locale G_generic3_AC = G_generic2_AC + G_generic3
locale G_generic4 = G_generic3 + forcing_data4
locale G_generic4_AC = G_generic3_AC + G_generic4
sublocale G_generic4_AC â ext:M_ZFC3_trans "M[G]"
using ground_replacements4 replacement_assm_MG
by unfold_locales simp_all
lemma (in forcing_data1) forces_neq_apply_imp_incompatible:
assumes
"p â© â
0`1 is 2â
[f,a,bâ§v]"
"q â© â
0`1 is 2â
[f,a,b'â§v]"
"b â b'"
and
types:"fâM" "aâM" "bâM" "b'âM" "pâP" "qâP"
shows
"p ⥠q"
proof -
{
fix G
assume "M_generic(G)"
then
interpret G_generic1 _ _ _ _ _ G by unfold_locales
include G_generic1_lemmas
assume "qâG"
with assms â¹M_generic(G)âº
have "M[G], map(val(P,G),[f,a,b'â§v]) ⨠â
0`1 is 2â
"
using truth_lemma[of "â
0`1 is 2â
" G "[f,a,b'â§v]"]
by (auto simp add:ord_simp_union arity_fun_apply_fm
fun_apply_type)
with â¹b â b'⺠types
have "M[G], map(val(P,G),[f,a,bâ§v]) ⨠â
‰
0`1 is 2â
â
"
using GenExtI by auto
}
with types
have "q â© â
‰
0`1 is 2â
â
[f,a,bâ§v]"
using definition_of_forcing[where Ï="â
‰
0`1 is 2â
â
" ] check_in_M
by (auto simp add:ord_simp_union arity_fun_apply_fm)
with â¹p â© â
0`1 is 2â
[f,a,bâ§v]⺠and types
show "p ⥠q"
using check_in_M inconsistent_imp_incompatible
by (simp add:ord_simp_union arity_fun_apply_fm fun_apply_type)
qed
context M_ctm3_AC
begin
lemmas sharp_simps = Card_rel_Union Card_rel_cardinal_rel Collect_abs
Cons_abs Cons_in_M_iff Diff_closed Equal_abs Equal_in_M_iff Finite_abs
Forall_abs Forall_in_M_iff Inl_abs Inl_in_M_iff Inr_abs Inr_in_M_iff
Int_closed Inter_abs Inter_closed M_nat Member_abs Member_in_M_iff
Memrel_closed Nand_abs Nand_in_M_iff Nil_abs Nil_in_M Ord_cardinal_rel
Pow_rel_closed Un_closed Union_abs Union_closed and_abs and_closed
apply_abs apply_closed bij_rel_closed bijection_abs bool_of_o_abs
bool_of_o_closed cadd_rel_0 cadd_rel_closed cardinal_rel_0_iff_0
cardinal_rel_closed cardinal_rel_idem cartprod_abs cartprod_closed
cmult_rel_0 cmult_rel_1 cmult_rel_closed comp_closed composition_abs
cons_abs cons_closed converse_abs converse_closed csquare_lam_closed
csquare_rel_closed depth_closed domain_abs domain_closed eclose_abs
eclose_closed empty_abs field_abs field_closed finite_funspace_closed
finite_ordinal_abs formula_N_abs formula_N_closed formula_abs
formula_case_abs formula_case_closed formula_closed
formula_functor_abs fst_closed function_abs function_space_rel_closed
hd_abs image_abs image_closed inj_rel_closed injection_abs inter_abs
irreflexive_abs is_depth_apply_abs is_eclose_n_abs is_funspace_abs
iterates_closed length_abs length_closed lepoll_rel_refl
limit_ordinal_abs linear_rel_abs list_N_abs list_N_closed list_abs
list_case'_closed list_case_abs list_closed list_functor_abs
mem_bij_abs mem_eclose_abs mem_inj_abs mem_list_abs membership_abs
minimum_closed nat_case_abs nat_case_closed nonempty not_abs
not_closed nth_abs number1_abs number2_abs number3_abs omega_abs
or_abs or_closed order_isomorphism_abs ordermap_closed
ordertype_closed ordinal_abs pair_abs pair_in_M_iff powerset_abs
pred_closed pred_set_abs quasilist_abs quasinat_abs radd_closed
rall_abs range_abs range_closed relation_abs restrict_closed
restriction_abs rex_abs rmult_closed rtrancl_abs rtrancl_closed
rvimage_closed separation_closed setdiff_abs singleton_abs
singleton_in_M_iff snd_closed strong_replacement_closed subset_abs
succ_in_M_iff successor_abs successor_ordinal_abs sum_abs sum_closed
surj_rel_closed surjection_abs tl_abs trancl_abs trancl_closed
transitive_rel_abs transitive_set_abs typed_function_abs union_abs
upair_abs upair_in_M_iff vimage_abs vimage_closed well_ord_abs
mem_formula_abs nth_closed Aleph_rel_closed csucc_rel_closed
Card_rel_Aleph_rel
declare sharp_simps[simp del, simplified setclass_iff, simp]
lemmas sharp_intros = nat_into_M Aleph_rel_closed Card_rel_Aleph_rel
declare sharp_intros[rule del, simplified setclass_iff, intro]
end
context G_generic4_AC begin
context
includes G_generic1_lemmas
begin
lemmas mg_sharp_simps = ext.Card_rel_Union ext.Card_rel_cardinal_rel
ext.Collect_abs ext.Cons_abs ext.Cons_in_M_iff ext.Diff_closed
ext.Equal_abs ext.Equal_in_M_iff ext.Finite_abs ext.Forall_abs
ext.Forall_in_M_iff ext.Inl_abs ext.Inl_in_M_iff ext.Inr_abs
ext.Inr_in_M_iff ext.Int_closed ext.Inter_abs ext.Inter_closed
ext.M_nat ext.Member_abs ext.Member_in_M_iff ext.Memrel_closed
ext.Nand_abs ext.Nand_in_M_iff ext.Nil_abs ext.Nil_in_M
ext.Ord_cardinal_rel ext.Pow_rel_closed ext.Un_closed
ext.Union_abs ext.Union_closed ext.and_abs ext.and_closed
ext.apply_abs ext.apply_closed ext.bij_rel_closed
ext.bijection_abs ext.bool_of_o_abs ext.bool_of_o_closed
ext.cadd_rel_0 ext.cadd_rel_closed ext.cardinal_rel_0_iff_0
ext.cardinal_rel_closed ext.cardinal_rel_idem ext.cartprod_abs
ext.cartprod_closed ext.cmult_rel_0 ext.cmult_rel_1
ext.cmult_rel_closed ext.comp_closed ext.composition_abs
ext.cons_abs ext.cons_closed ext.converse_abs ext.converse_closed
ext.csquare_lam_closed ext.csquare_rel_closed ext.depth_closed
ext.domain_abs ext.domain_closed ext.eclose_abs ext.eclose_closed
ext.empty_abs ext.field_abs ext.field_closed
ext.finite_funspace_closed ext.finite_ordinal_abs ext.formula_N_abs
ext.formula_N_closed ext.formula_abs ext.formula_case_abs
ext.formula_case_closed ext.formula_closed ext.formula_functor_abs
ext.fst_closed ext.function_abs ext.function_space_rel_closed
ext.hd_abs ext.image_abs ext.image_closed ext.inj_rel_closed
ext.injection_abs ext.inter_abs ext.irreflexive_abs
ext.is_depth_apply_abs ext.is_eclose_n_abs ext.is_funspace_abs
ext.iterates_closed ext.length_abs ext.length_closed
ext.lepoll_rel_refl ext.limit_ordinal_abs ext.linear_rel_abs
ext.list_N_abs ext.list_N_closed ext.list_abs
ext.list_case'_closed ext.list_case_abs ext.list_closed
ext.list_functor_abs ext.mem_bij_abs ext.mem_eclose_abs
ext.mem_inj_abs ext.mem_list_abs ext.membership_abs
ext.nat_case_abs ext.nat_case_closed
ext.nonempty ext.not_abs ext.not_closed ext.nth_abs
ext.number1_abs ext.number2_abs ext.number3_abs ext.omega_abs
ext.or_abs ext.or_closed ext.order_isomorphism_abs
ext.ordermap_closed ext.ordertype_closed ext.ordinal_abs
ext.pair_abs ext.pair_in_M_iff ext.powerset_abs ext.pred_closed
ext.pred_set_abs ext.quasilist_abs ext.quasinat_abs
ext.radd_closed ext.rall_abs ext.range_abs ext.range_closed
ext.relation_abs ext.restrict_closed ext.restriction_abs
ext.rex_abs ext.rmult_closed ext.rtrancl_abs ext.rtrancl_closed
ext.rvimage_closed ext.separation_closed ext.setdiff_abs
ext.singleton_abs ext.singleton_in_M_iff ext.snd_closed
ext.strong_replacement_closed ext.subset_abs ext.succ_in_M_iff
ext.successor_abs ext.successor_ordinal_abs ext.sum_abs
ext.sum_closed ext.surj_rel_closed ext.surjection_abs ext.tl_abs
ext.trancl_abs ext.trancl_closed ext.transitive_rel_abs
ext.transitive_set_abs ext.typed_function_abs ext.union_abs
ext.upair_abs ext.upair_in_M_iff ext.vimage_abs ext.vimage_closed
ext.well_ord_abs ext.mem_formula_abs ext.nth_closed ext.Aleph_rel_closed
ext.csucc_rel_closed ext.Card_rel_Aleph_rel
declare mg_sharp_simps[simp del, simplified setclass_iff, simp]
lemmas mg_sharp_intros = ext.nat_into_M ext.Aleph_rel_closed
ext.Card_rel_Aleph_rel
declare mg_sharp_intros[rule del, simplified setclass_iff, intro]
lemma forces_below_filter:
assumes "M[G], map(val(P,G),env) ⨠Ï" "p â G"
"arity(Ï) ⤠length(env)" "Ï â formula" "env â list(M)"
shows "âqâG. q â¼ p â§ q â© Ï env"
proof -
note assms
moreover from this
obtain r where "r â© Ï env" "râG"
using generic truth_lemma[of Ï _ env]
by blast
moreover from this and â¹pâGâº
obtain q where "q â¼ p" "q â¼ r" "q â G" by auto
ultimately
show ?thesis
using strengthening_lemma[of r Ï _ env] by blast
qed
subsectionâ¹Preservation by ccc forcing notionsâº
definition check_fm' where
"check_fm'(ofm,arg,res) â¡ check_fm(arg,ofm,res)"
lemma ccc_fun_closed_lemma_aux:
assumes "f_dotâM" "pâM" "aâM" "bâM"
shows "{q â P . q â¼ p â§ (M, [q, P, leq, ð, f_dot, aâ§v, bâ§v] ⨠forces(â
0`1 is 2â
))} â M"
proof -
have "â
0`1 is 2â
â formula" "arity(â
0`1 is 2â
) = 3"
using arity_fun_apply_fm union_abs1
by simp_all
then
show ?thesis
using separation_forces[where env="[f_dot, aâ§v, bâ§v]" and Ï="â
0`1 is 2â
",simplified]
assms G_subset_M[THEN subsetD] generic one_in_M P_in_M
separation_in lam_replacement_constant lam_replacement_identity
lam_replacement_Pair[THEN[5] lam_replacement_hcomp2] leq_in_M check_in_M
separation_conj separation_forces
by simp_all
qed
lemma ccc_fun_closed_lemma_aux2:
assumes "BâM" "f_dotâM" "pâM" "aâM"
shows "(##M)(λbâB. {q â P . q â¼ p â§ (M, [q, P, leq, ð, f_dot, aâ§v, bâ§v] ⨠forces(â
0`1 is 2â
))})"
proof -
have "separation(##M, λz. M, [snd(z), P, leq, ð, f_dot, Ï, fst(fst(z))â§v] ⨠forces(â
0`1 is 2â
))"
if "ÏâM" for Ï
proof -
let ?f_fm="snd_fm(1,0)"
let ?g_fm="hcomp_fm(check_fm'(6),hcomp_fm(fst_fm,fst_fm),2,0)"
note types = assms leq_in_M P_in_M one_in_M
have "arity(forces(â
0`1 is 2â
)) ⤠7"
using arity_fun_apply_fm union_abs1 arity_forces[of "â
0`1 is 2â
"]
by simp
moreover
have "?f_fm â formula" "arity(?f_fm) ⤠7" "?g_fm â formula" "arity(?g_fm) ⤠8"
using ord_simp_union
unfolding hcomp_fm_def check_fm'_def
by (simp_all add:arity)
ultimately
show ?thesis
using separation_sat_after_function types that sats_fst_fm
snd_abs types sats_snd_fm sats_check_fm check_abs check_in_M fst_abs
unfolding hcomp_fm_def check_fm'_def
by simp
qed
then
show ?thesis
using lam_replacement_imp_lam_closed lam_replacement_Collect
separation_conj separation_in separation_forces separation_ball separation_iff'
lam_replacement_Pair[THEN [5] lam_replacement_hcomp2] lam_replacement_identity
lam_replacement_constant lam_replacement_snd lam_replacement_fst lam_replacement_hcomp
ccc_fun_closed_lemma_aux arity_fun_apply_fm union_abs1
transitivity[of _ B] leq_in_M assms
by simp
qed
lemma ccc_fun_closed_lemma:
assumes "AâM" "BâM" "f_dotâM" "pâM"
shows "(λaâA. {bâB. âqâP. q â¼ p â§ (q â© â
0`1 is 2â
[f_dot, aâ§v, bâ§v])}) â M"
proof -
have "separation(##M, λz. M, [snd(z), P, leq, ð, f_dot, fst(fst(fst(z)))â§v, snd(fst(z))â§v] ⨠forces(â
0`1 is 2â
))"
proof -
note types = assms leq_in_M P_in_M one_in_M
let ?f_fm="snd_fm(1,0)"
let ?g="λz . fst(fst(fst(z)))â§v"
let ?g_fm="hcomp_fm(check_fm'(6),hcomp_fm(fst_fm,hcomp_fm(fst_fm,fst_fm)),2,0)"
let ?h_fm="hcomp_fm(check_fm'(7),hcomp_fm(snd_fm,fst_fm),3,0)"
have "arity(forces(â
0`1 is 2â
)) ⤠7"
using arity_fun_apply_fm union_abs1 arity_forces[of "â
0`1 is 2â
"] by simp
moreover
have "?f_fm â formula" "arity(?f_fm) ⤠6" "?g_fm â formula" "arity(?g_fm) ⤠7"
"?h_fm â formula" "arity(?h_fm) ⤠8"
using ord_simp_union
unfolding hcomp_fm_def check_fm'_def
by (simp_all add:arity)
ultimately
show ?thesis
using separation_sat_after_function3 assms types sats_check_fm check_abs check_in_M
fst_abs snd_abs
unfolding hcomp_fm_def check_fm'_def
by simp
qed
moreover
have "separation(##M, λz. M, [snd(z), P, leq, ð, f_dot, Ï, fst(z)â§v] ⨠forces(â
0`1 is 2â
))"
if "ÏâM" for Ï
proof -
let ?f_fm="snd_fm(1,0)"
let ?g_fm="hcomp_fm(check_fm'(6),fst_fm,2,0)"
note types = assms leq_in_M P_in_M one_in_M
have "arity(forces(â
0`1 is 2â
)) ⤠7"
using arity_forces[of "â
0`1 is 2â
"] arity_fun_apply_fm union_abs1
by simp
moreover
have "?f_fm â formula" "arity(?f_fm) ⤠7" "?g_fm â formula" "arity(?g_fm) ⤠8"
using ord_simp_union
unfolding hcomp_fm_def check_fm'_def
by (simp_all add:arity)
ultimately
show ?thesis
using separation_sat_after_function assms types that fst_abs
snd_abs types sats_check_fm check_abs check_in_M
unfolding hcomp_fm_def check_fm'_def
by simp
qed
ultimately
show ?thesis
using lam_replacement_imp_lam_closed lam_replacement_Collect
lam_replacement_constant lam_replacement_identity lam_replacement_snd lam_replacement_fst
lam_replacement_hcomp lam_replacement_Pair[THEN [5] lam_replacement_hcomp2]
separation_conj separation_in separation_ball separation_bex separation_iff'
transitivity[of _ A] leq_in_M assms
by simp
qed
lemma ccc_fun_approximation_lemma:
notes le_trans[trans]
assumes "cccâMâ(P,leq)" "AâM" "BâM" "fâM[G]" "f : A â B"
shows
"âFâM. F : A â PowâMâ(B) â§ (âaâA. f`a â F`a â§ |F`a|âMâ ⤠Ï)"
proof -
from â¹fâM[G]âº
obtain f_dot where "f = val(P,G,f_dot)" "f_dotâM" using GenExtD by force
with assms
obtain p where "p â© â
0:1â2â
[f_dot, Aâ§v, Bâ§v]" "pâG" "pâM"
using transitivity[OF M_genericD P_in_M]
generic truth_lemma[of "â
0:1â2â
" G "[f_dot, Aâ§v, Bâ§v]"]
by (auto simp add:ord_simp_union arity_typed_function_fm
typed_function_type)
define F where "Fâ¡Î»aâA. {bâB. âqâP. q â¼ p â§ (q â© â
0`1 is 2â
[f_dot, aâ§v, bâ§v])}"
from assms â¹f_dotâ_⺠â¹pâMâº
have "F â M"
unfolding F_def using ccc_fun_closed_lemma by simp
moreover from calculation
have "f`a â F`a" if "a â A" for a
proof -
note â¹f: A â B⺠â¹a â Aâº
moreover from this
have "f ` a â B" by simp
moreover
note â¹fâM[G]⺠â¹AâMâº
moreover from calculation
have "M[G], [f, a, f`a] ⨠â
0`1 is 2â
"
by (auto dest:transM)
moreover
note â¹BâM⺠â¹f = val(P,G,f_dot)âº
moreover from calculation
have "aâM" "val(P,G, f_dot)`aâM"
by (auto dest:transM)
moreover
note â¹f_dotâM⺠â¹pâGâº
ultimately
obtain q where "q â¼ p" "q â© â
0`1 is 2â
[f_dot, aâ§v, (f`a)â§v]" "qâG"
using forces_below_filter[of "â
0`1 is 2â
" "[f_dot, aâ§v, (f`a)â§v]" p]
by (auto simp add: ord_simp_union arity_fun_apply_fm
fun_apply_type)
with â¹f`a â Bâº
have "f`a â {bâB . âqâP. q â¼ p â§ q â© â
0`1 is 2â
[f_dot, aâ§v, bâ§v]}"
by blast
with â¹aâAâº
show ?thesis unfolding F_def by simp
qed
moreover
have "|F`a|âMâ â¤ Ï â§ F`aâM" if "a â A" for a
proof -
let ?Q="λb. {qâP. q â¼ p â§ (q â© â
0`1 is 2â
[f_dot, aâ§v, bâ§v])}"
from â¹F â M⺠â¹aâA⺠â¹AâMâº
have "F`a â M" "aâM"
using transitivity[OF _ â¹AâMâº] by simp_all
moreover
have 2:"âx. xâF`a â¹ xâM"
using transitivity[OF _ â¹F`aâMâº] by simp
moreover
have 3:"âx. xâF`a â¹ (##M)(?Q(x))"
using ccc_fun_closed_lemma_aux[OF â¹f_dotâM⺠â¹pâM⺠â¹aâM⺠2] transitivity[of _ "F`a"]
by simp
moreover
have 4:"lam_replacement(##M,λb. {q â P . q â¼ p â§ (M, [q, P, leq, ð, f_dot, aâ§v, bâ§v] ⨠forces(â
0`1 is 2â
))})"
using ccc_fun_closed_lemma_aux2[OF _ â¹f_dotâM⺠â¹pâM⺠â¹aâMâº]
lam_replacement_iff_lam_closed[THEN iffD2]
ccc_fun_closed_lemma_aux[OF â¹f_dotâM⺠â¹pâM⺠â¹aâMâº]
by simp
ultimately
interpret M_Pi_assumptions_choice "##M" "F`a" ?Q
using Pi_replacement1[OF _ 3] lam_replacement_Sigfun[OF 4]
lam_replacement_imp_strong_replacement
ccc_fun_closed_lemma_aux[OF â¹f_dotâM⺠â¹pâM⺠â¹aâMâº]
lam_replacement_hcomp2[OF lam_replacement_constant 4 _ _
lam_replacement_minimum,unfolded lam_replacement_def]
by unfold_locales simp_all
from â¹F`a â Mâº
interpret M_Pi_assumptions2 "##M" "F`a" ?Q "λ_ . P"
using P_in_M lam_replacement_imp_strong_replacement[OF
lam_replacement_Sigfun[OF lam_replacement_constant]]
Pi_replacement1 transM[of _ "F`a"]
by unfold_locales simp_all
from â¹p â© â
0:1â2â
[f_dot, Aâ§v, Bâ§v]⺠â¹aâAâº
have "ây. y â ?Q(b)" if "b â F`a" for b
using that unfolding F_def by auto
then
obtain q where "q â PiâMâ(F`a,?Q)" "qâM" using AC_Pi_rel by auto
moreover
note â¹F`a â Mâº
moreover from calculation
have "q : F`a ââMâ P"
using Pi_rel_weaken_type def_function_space_rel by auto
moreover from calculation
have "q : F`a â range(q)" "q : F`a â P" "q : F`a ââMâ range(q)"
using mem_function_space_rel_abs range_of_fun by simp_all
moreover
have "q`b ⥠q`c" if "b â F`a" "c â F`a" "b â c"
for b c
proof -
from â¹b â F`a⺠â¹c â F`a⺠â¹q â PiâMâ(F`a,?Q)⺠â¹qâMâº
have "q`b â© â
0`1 is 2â
[f_dot, aâ§v, bâ§v]"
"q`c â© â
0`1 is 2â
[f_dot, aâ§v, câ§v]"
using mem_Pi_rel_abs[of q] apply_type[of _ _ ?Q]
by simp_all
with â¹b â c⺠â¹q : F`a â P⺠â¹aâA⺠â¹bâ_⺠â¹câ_âº
â¹AâM⺠â¹f_dotâM⺠â¹F`aâMâº
show ?thesis
using forces_neq_apply_imp_incompatible
transitivity[of _ A] transitivity[of _ "F`a"]
by auto
qed
moreover from calculation
have "antichain(range(q))"
using Pi_range_eq[of _ _ "λ_ . P"]
unfolding antichain_def by auto
moreover from this and â¹qâMâº
have "antichain_r'(range(q))"
by (simp add:absolut)
moreover from calculation
have "q`b â q`c" if "b â c" "b â F`a" "c â F`a" for b c
using that Incompatible_imp_not_eq apply_type
mem_function_space_rel_abs by simp
ultimately
have "q â injâMâ(F`a,range(q))"
using def_inj_rel by auto
with â¹F`a â M⺠â¹qâMâº
have "|F`a|âMâ ⤠|range(q)|âMâ"
using def_lepoll_rel
by (rule_tac lepoll_rel_imp_cardinal_rel_le) auto
also from â¹antichain_r'(range(q))⺠â¹cccâMâ(P,leq)⺠â¹qâMâº
have "|range(q)|âMâ ⤠Ï"
using def_ccc_rel by simp
finally
show ?thesis using â¹F`aâM⺠by auto
qed
moreover from this
have "F`aâM" if "aâA" for a
using that by simp
moreover from this â¹BâMâº
have "F : A â PowâMâ(B)"
using Pow_rel_char
unfolding F_def by (rule_tac lam_type) auto
ultimately
show ?thesis by auto
qed
end
end
endiv class="head">
Theory Not_CH
sectionâ¹Model of the negation of the Continuum Hypothesisâº
theory Not_CH
imports
Cardinal_Preservation
begin
txtâ¹We are taking advantage that the poset of finite functions is absolute,
and thus we work with the unrelativized \<^term>â¹Fnâº. But it would have been more
appropriate to do the following using the relative \<^term>â¹Fn_relâº. As it turns
out, the present theory was developed prior to having \<^term>â¹Fn⺠relativized!
We also note that \<^term>â¹Fn(Ï,κÃÏ,2)⺠is separative, i.e. each \<^term>â¹X â Fn(Ï,κÃÏ,2)âº
has two incompatible extensions; therefore we may recover part of our previous theorem
@{thm [source] extensions_of_ctms_ZF}. But that result also included the possibility
of not having $\AC$ in the ground model, which would not be sensible in a context
where the cardinality of the continuum is under discussion. It is also the case that
@{thm [source] extensions_of_ctms_ZF} was historically our first formalized result
(with a different proof) that showed the forcing machinery had all of its elements
in place.âº
abbreviation
Add_subs :: "i â i" where
"Add_subs(κ) â¡ Fn(Ï,κÃÏ,2)"
abbreviation
Add_le :: "i â i" where
"Add_le(κ) â¡ Fnle(Ï,κ à Ï,2)"
lemma (in M_aleph) Aleph_rel2_closed[intro,simp]: "M(âµâ2ââMâ)"
using nat_into_Ord by simp
locale M_master = M_cohen + M_library_DC +
assumes
UN_lepoll_assumptions:
"M(A) â¹ M(b) â¹ M(f) â¹ M(A') â¹ separation(M, λy. âxâA'. y = â¨x, μ i. xâif_range_F_else_F((`)(A), b, f, i)â©)"
subsectionâ¹Non-absolute concepts between extensionsâº
locale M_master_sub = M_master + N:M_master N for N +
assumes
M_imp_N: "M(x) â¹ N(x)" and
Ord_iff: "Ord(x) â¹ M(x) â· N(x)"
sublocale M_master_sub â M_N_Perm
using M_imp_N by unfold_locales
context M_master_sub
begin
lemma cardinal_rel_le_cardinal_rel: "M(X) â¹ |X|âNâ ⤠|X|âMâ"
using M_imp_N N.lepoll_rel_cardinal_rel_le[OF lepoll_rel_transfer Card_rel_is_Ord]
cardinal_rel_eqpoll_rel[THEN eqpoll_rel_sym, THEN eqpoll_rel_imp_lepoll_rel]
by simp
lemma Aleph_rel_sub_closed: "Ord(α) â¹ M(α) â¹ N(âµâαââMâ)"
using Ord_iff[THEN iffD1, OF Card_rel_Aleph_rel[THEN Card_rel_is_Ord]]
by simp
lemma Card_rel_imp_Card_rel: "CardâNâ(κ) â¹ M(κ) â¹ CardâMâ(κ)"
using N.Card_rel_is_Ord[of κ] M_imp_N Ord_cardinal_rel_le[of κ]
cardinal_rel_le_cardinal_rel[of κ] le_anti_sym
unfolding Card_rel_def by auto
lemma csucc_rel_le_csucc_rel:
assumes "Ord(κ)" "M(κ)"
shows "(κâ§+)âMâ ⤠(κâ§+)âNâ"
proof -
note assms
moreover from this
have "N(L) â§ CardâNâ(L) ⧠κ < L â¹ M(L) â§ CardâMâ(L) ⧠κ < L"
(is "?P(L) â¹ ?Q(L)") for L
using M_imp_N Ord_iff[THEN iffD2, of L] N.Card_rel_is_Ord lt_Ord
Card_rel_imp_Card_rel by auto
moreover from assms
have "N((κâ§+)âNâ)" "CardâNâ((κâ§+)âNâ)" "κ < (κâ§+)âNâ"
using N.lt_csucc_rel[of κ] N.Card_rel_csucc_rel[of κ] M_imp_N by simp_all
ultimately
show ?thesis
using M_imp_N Least_antitone[of _ ?P ?Q] unfolding csucc_rel_def by blast
qed
lemma Aleph_rel_le_Aleph_rel: "Ord(α) â¹ M(α) â¹ âµâαââMâ ⤠âµâαââNâ"
proof (induct rule:trans_induct3)
case 0
then
show ?case
using Aleph_rel_zero N.Aleph_rel_zero by simp
next
case (succ x)
then
have "âµâxââMâ ⤠âµâxââNâ" "Ord(x)" "M(x)" by simp_all
moreover from this
have "(âµâxââMââ§+)âMâ ⤠(âµâxââNââ§+)âMâ"
using M_imp_N Ord_iff[THEN iffD2, OF N.Card_rel_is_Ord]
by (intro csucc_rel_le_mono) simp_all
moreover from calculation
have "(âµâxââNââ§+)âMâ ⤠(âµâxââNââ§+)âNâ"
using M_imp_N N.Card_rel_is_Ord Ord_iff[THEN iffD2, OF N.Card_rel_is_Ord]
by (intro csucc_rel_le_csucc_rel) auto
ultimately
show ?case
using M_imp_N Aleph_rel_succ N.Aleph_rel_succ csucc_rel_le_csucc_rel
le_trans by auto
next
case (limit x)
then
show ?case
using M_imp_N Aleph_rel_limit N.Aleph_rel_limit
by simp (blast dest: transM intro!:le_implies_UN_le_UN)
qed
end
lemmas (in M_ZF3_trans) sep_instances =
separation_insnd_ballPair
separation_ifrangeF_body separation_ifrangeF_body2 separation_ifrangeF_body3
separation_ifrangeF_body4 separation_ifrangeF_body5 separation_ifrangeF_body6
separation_ifrangeF_body7 separation_cardinal_rel_lesspoll_rel
separation_is_dcwit_body
lemmas (in M_ZF3_trans) repl_instances = lam_replacement_inj_rel
lam_replacement_cardinal replacement_trans_apply_image
sublocale M_ZFC3_trans â M_master "##M"
using replacement_dcwit_repl_body
by unfold_locales (simp_all add:repl_instances sep_instances del:setclass_iff
add: transrec_replacement_def wfrec_replacement_def dcwit_repl_body_def)
subsectionâ¹Cohen forcing is cccâº
context M_ctm3_AC
begin
lemma ccc_Add_subs_Aleph_2: "cccâMâ(Add_subs(âµâ2ââMâ),Add_le(âµâ2ââMâ))"
proof -
interpret M_add_reals "##M" "âµâ2ââMâ à Ï"
by unfold_locales blast
show ?thesis
using ccc_rel_Fn_nat by fast
qed
end
sublocale G_generic4_AC â M_master_sub "##M" "##(M[G])"
using M_subset_MG[OF one_in_G] generic Ord_MG_iff
by unfold_locales auto
lemma (in M_trans) mem_F_bound4:
fixes F A
defines "F â¡ (`)"
shows "xâF(A,c) â¹ c â (range(f) ⪠domain(A))"
using apply_0 unfolding F_def
by (cases "M(c)", auto simp:F_def)
lemma (in M_trans) mem_F_bound5:
fixes F A
defines "F ⡠λ_ x. A`x "
shows "xâF(A,c) â¹ c â (range(f) ⪠domain(A))"
using apply_0 unfolding F_def
by (cases "M(c)", auto simp:F_def drSR_Y_def dC_F_def)
sublocale M_ctm3_AC â M_replacement_lepoll "##M" "(`)"
using UN_lepoll_assumptions lam_replacement_apply lam_replacement_inj_rel
mem_F_bound4 apply_0
unfolding lepoll_assumptions_defs
proof (unfold_locales,
rule_tac [3] lam_Least_assumption_general[where U=domain, OF _ mem_F_bound4], simp_all)
fix A i x
assume "A â M" "x â M" "x â A ` i"
then
show "i â M"
using apply_0[of i A] transM[of _ "domain(A)", simplified]
by force
qed
context G_generic4_AC begin
context
includes G_generic1_lemmas
begin
lemma G_in_MG: "G â M[G]"
using G_in_Gen_Ext[ OF _ one_in_G, OF _ generic]
by blast
lemma ccc_preserves_Aleph_succ:
assumes "cccâMâ(P,leq)" "Ord(z)" "z â M"
shows "CardâM[G]â(âµâsucc(z)ââMâ)"
proof (rule ccontr)
assume "¬ CardâM[G]â(âµâsucc(z)ââMâ)"
moreover
note â¹z â M⺠â¹Ord(z)âº
moreover from this
have "Ord(âµâsucc(z)ââMâ)"
using Card_rel_is_Ord by fastforce
ultimately
obtain α f where "α < âµâsucc(z)ââMâ" "f â surjâM[G]â(α, âµâsucc(z)ââMâ)"
using ext.lt_surj_rel_empty_imp_Card_rel M_subset_MG[OF one_in_G, OF generic]
by force
moreover from this and â¹zâM⺠â¹Ord(z)âº
have "α â M" "f â M[G]"
using ext.trans_surj_rel_closed
by (auto dest:transM ext.transM dest!:ltD)
moreover
note â¹cccâMâ(P,leq)⺠â¹zâMâº
ultimately
obtain F where "F:αâPowâMâ(âµâsucc(z)ââMâ)" "âβâα. f`β â F`β" "âβâα. |F`β|âMâ ⤠Ï"
"F â M"
using ccc_fun_approximation_lemma[of α "âµâsucc(z)ââMâ" f]
ext.mem_surj_abs[of f α "âµâsucc(z)ââMâ"] â¹Ord(z)âº
surj_is_fun[of f α "âµâsucc(z)ââMâ"] by auto
then
have "β â α â¹ |F`β|âMâ ⤠âµâ0ââMâ" for β
using Aleph_rel_zero by simp
have "w â F ` x â¹ x â M" for w x
proof -
fix w x
assume "w â F`x"
then
have "x â domain(F)"
using apply_0 by auto
with â¹F:αâPowâMâ(âµâsucc(z)ââMâ)âº
have "x â α"
using domain_of_fun by simp
with â¹Î± â Mâº
show "x â M" by (auto dest:transM)
qed
with â¹Î± â M⺠â¹F:αâPowâMâ(âµâsucc(z)ââMâ)⺠â¹FâMâº
interpret M_cardinal_UN_lepoll "##M" "λβ. F`β" α
using UN_lepoll_assumptions lepoll_assumptions
lam_replacement_apply lam_replacement_inj_rel
proof (unfold_locales, auto dest:transM simp del:if_range_F_else_F_def)
fix f b
assume "bâM" "fâM"
with â¹FâMâº
show "lam_replacement(##M, λx. μ i. x â if_range_F_else_F((`)(F), b, f, i))"
using UN_lepoll_assumptions mem_F_bound5
by (rule_tac lam_Least_assumption_general[where U="domain", OF _ mem_F_bound5])
simp_all
qed
from â¹Î± < âµâsucc(z)ââMâ⺠â¹Î± â M⺠assms
have "α â²âMâ âµâzââMâ"
using
Aleph_rel_zero
cardinal_rel_lt_csucc_rel_iff[of "âµâzââMâ" α]
le_Card_rel_iff[of "âµâzââMâ" α]
Aleph_rel_succ[of z] Card_rel_lt_iff[of α "âµâsucc(z)ââMâ"]
lt_Ord[of α "âµâsucc(z)ââMâ"]
Card_rel_csucc_rel[of "âµâzââMâ"]
Aleph_rel_closed[of z]
Card_rel_Aleph_rel[THEN Card_rel_is_Ord, OF _ _ Aleph_rel_closed]
by simp
with â¹Î± < âµâsucc(z)ââMâ⺠â¹âβâα. |F`β|âMâ ⤠Ï⺠â¹Î± â M⺠assms
have "|âβâα. F`β|âMâ ⤠âµâzââMâ"
using InfCard_rel_Aleph_rel[of z] Aleph_rel_zero
subset_imp_lepoll_rel[THEN lepoll_rel_imp_cardinal_rel_le,
of "âβâα. F`β" "âµâzââMâ"] Aleph_rel_succ
Aleph_rel_increasing[THEN leI, THEN [2] le_trans, of _ 0 z]
Ord_0_lt_iff[THEN iffD1, of z]
by (cases "0<z"; rule_tac leqpoll_rel_imp_cardinal_rel_UN_le) (auto, force)
moreover
note â¹zâM⺠â¹Ord(z)âº
moreover from â¹âβâα. f`β â F`β⺠â¹f â surjâM[G]â(α, âµâsucc(z)ââMâ)âº
â¹Î± â M⺠â¹f â M[G]⺠and this
have "âµâsucc(z)ââMâ â (âβâα. F`β)"
using ext.mem_surj_abs by (force simp add:surj_def)
moreover from â¹F â M⺠â¹Î± â Mâº
have "(âxâα. F ` x) â M"
using j.B_replacement
by (intro Union_closed[simplified] RepFun_closed[simplified])
(auto dest:transM)
ultimately
have "âµâsucc(z)ââMâ ⤠âµâzââMâ"
using subset_imp_le_cardinal_rel[of "âµâsucc(z)ââMâ" "âβâα. F`β"]
le_trans by auto
with assms
show "False"
using Aleph_rel_increasing not_le_iff_lt[of "âµâsucc(z)ââMâ" "âµâzââMâ"]
Card_rel_Aleph_rel[THEN Card_rel_is_Ord]
by auto
qed
end
end
context M_ctm1
begin
abbreviation
Add :: "i" where
"Add â¡ Fn(Ï, âµâ2ââMâ à Ï, 2)"
end
locale add_generic4 = G_generic4_AC "Fn(Ï, âµâ2ââ##Mâ à Ï, 2)" "Fnle(Ï, âµâ2ââ##Mâ à Ï, 2)" 0
sublocale add_generic4 â cohen_data Ï "âµâ2ââMâ à Ï" 2 by unfold_locales auto
context add_generic4
begin
notation Leq (infixl "â¼" 50)
notation Incompatible (infixl "â¥" 50)
notation GenExt_at_P ("_[_]" [71,1])
lemma Add_subs_preserves_Aleph_succ: "Ord(z) â¹ zâM â¹ CardâM[G]â(âµâsucc(z)ââMâ)"
using ccc_preserves_Aleph_succ ccc_Add_subs_Aleph_2
by auto
lemma Aleph_rel_nats_MG_eq_Aleph_rel_nats_M:
includes G_generic1_lemmas
assumes "z â Ï"
shows "âµâzââM[G]â = âµâzââMâ"
using assms
proof (induct)
case 0
have "âµâ0ââM[G]â = Ï"
using ext.Aleph_rel_zero .
also
have "Ï = âµâ0ââMâ"
using Aleph_rel_zero by simp
finally
show ?case .
next
case (succ z)
then
have "âµâsucc(z)ââMâ ⤠âµâsucc(z)ââM[G]â"
using Aleph_rel_le_Aleph_rel nat_into_M by simp
moreover from â¹z â Ïâº
have "âµâzââMâ â M[G]" "âµâsucc(z)ââMâ â M[G]"
using nat_into_M by simp_all
moreover from this and â¹âµâzââM[G]â = âµâzââMâ⺠â¹z â Ïâº
have "âµâsucc(z)ââM[G]â ⤠âµâsucc(z)ââMâ"
using ext.Aleph_rel_succ nat_into_M
Add_subs_preserves_Aleph_succ[THEN ext.csucc_rel_le, of z]
Aleph_rel_increasing[of z "succ(z)"]
by simp
ultimately
show ?case using le_anti_sym by blast
qed
abbreviation
f_G :: "i" (â¹fâGââº) where
"fâGâ â¡ âG"
abbreviation
dom_dense :: "iâi" where
"dom_dense(x) â¡ { pâAdd . x â domain(p) }"
lemma dense_dom_dense: "x â âµâ2ââMâ Ã Ï â¹ dense(dom_dense(x))"
proof
fix p
assume "x â âµâ2ââMâ à Ï" "p â Add"
show "âdâdom_dense(x). d â¼ p"
proof (cases "x â domain(p)")
case True
with â¹x â âµâ2ââMâ à Ï⺠â¹p â Addâº
show ?thesis using refl_leq by auto
next
case False
note â¹p â Addâº
moreover from this and False and â¹x â âµâ2ââMâ à Ïâº
have "cons(â¨x,0â©, p) â Add"
using FiniteFun.consI[of x "âµâ2ââMâ à Ï" 0 2 p]
Fn_nat_eq_FiniteFun by auto
moreover from â¹p â Addâº
have "xâdomain(cons(â¨x,0â©, p))" by simp
ultimately
show ?thesis
by (fastforce del:FnD)
qed
qed
declare (in M_ctm3_AC) Fn_nat_closed[simplified setclass_iff, simp, intro]
declare (in M_ctm3_AC) Fnle_nat_closed[simp del, rule del,
simplified setclass_iff, simp, intro]
declare (in M_ctm3_AC) cexp_rel_closed[simplified setclass_iff, simp, intro]
declare (in G_generic4_AC) ext.cexp_rel_closed[simplified setclass_iff, simp, intro]
lemma dom_dense_closed[intro,simp]: "x â âµâ2ââMâ Ã Ï â¹ dom_dense(x) â M"
using separation_in_domain[of x] nat_into_M
by (rule_tac separation_closed[simplified], blast dest:transM) simp
lemma domain_f_G: assumes "x â âµâ2ââMâ" "y â Ï"
shows "â¨x, yâ© â domain(fâGâ)"
proof -
from assms
have "dense(dom_dense(â¨x, yâ©))" using dense_dom_dense by simp
with assms
obtain p where "pâdom_dense(â¨x, yâ©)" "pâG"
using generic[THEN M_generic_denseD, of "dom_dense(â¨x, yâ©)"]
by auto
then
show "â¨x, yâ© â domain(fâGâ)" by blast
qed
lemma f_G_funtype:
includes G_generic1_lemmas
shows "fâGâ : âµâ2ââMâ Ã Ï â 2"
using generic domain_f_G
unfolding Pi_def
proof (auto)
show "x â B â¹ B â G â¹ x â (âµâ2ââMâ à Ï) à 2" for B x
using Fn_nat_subset_Pow by blast
show "function(fâGâ)"
using Un_filter_is_function generic
unfolding M_generic_def by fast
qed
abbreviation
inj_dense :: "iâiâi" where
"inj_dense(w,x) â¡
{ pâAdd . (ânâÏ. â¨â¨w,nâ©,1â© â p â§ â¨â¨x,nâ©,0â© â p) }"
lemma dense_inj_dense:
assumes "w â âµâ2ââMâ" "x â âµâ2ââMâ" "w â x"
shows "dense(inj_dense(w,x))"
proof
fix p
assume "p â Add"
then
obtain n where "â¨w,nâ© â domain(p)" "â¨x,nâ© â domain(p)" "n â Ï"
proof -
{
assume "â¨w,nâ© â domain(p) ⨠â¨x,nâ© â domain(p)" if "n â Ï" for n
then
have "Ï â range(domain(p))" by blast
then
have "¬ Finite(p)"
using Finite_range Finite_domain subset_Finite nat_not_Finite
by auto
with â¹p â Addâº
have False
using Fn_nat_eq_FiniteFun FiniteFun.dom_subset[of "âµâ2ââMâ à Ï" 2]
Fin_into_Finite by auto
}
with that
show ?thesis by auto
qed
moreover
note â¹p â Add⺠assms
moreover from calculation
have "cons(â¨â¨x,nâ©,0â©, p) â Add"
using FiniteFun.consI[of "â¨x,nâ©" "âµâ2ââMâ à Ï" 0 2 p]
Fn_nat_eq_FiniteFun by auto
ultimately
have "cons(â¨â¨w,nâ©,1â©, cons(â¨â¨x,nâ©,0â©, p) ) â Add"
using FiniteFun.consI[of "â¨w,nâ©" "âµâ2ââMâ à Ï" 1 2 "cons(â¨â¨x,nâ©,0â©, p)"]
Fn_nat_eq_FiniteFun by auto
with â¹n â Ïâº
show "âdâinj_dense(w,x). d â¼ p"
using â¹p â Add⺠by (intro bexI) auto
qed
lemma inj_dense_closed[intro,simp]:
"w â âµâ2ââMâ â¹ x â âµâ2ââMâ â¹ inj_dense(w,x) â M"
using transM[OF _ Aleph_rel2_closed] separation_conj separation_bex
lam_replacement_hcomp2[OF _ _ _ _ lam_replacement_Pair]
separation_in lam_replacement_fst lam_replacement_snd lam_replacement_constant
lam_replacement_hcomp[OF lam_replacement_snd lam_replacement_restrict']
separation_bex separation_conj
by simp
lemma Aleph_rel2_new_reals:
assumes "w â âµâ2ââMâ" "x â âµâ2ââMâ" "w â x"
shows "(λnâÏ. fâGâ ` â¨w, nâ©) â (λnâÏ. fâGâ ` â¨x, nâ©)"
proof -
from assms
have "dense(inj_dense(w,x))" using dense_inj_dense by simp
with assms
obtain p where "pâinj_dense(w,x)" "pâG"
using generic[THEN M_generic_denseD, of "inj_dense(w,x)"]
by blast
then
obtain n where "n â Ï" "â¨â¨w, nâ©, 1â© â p" "â¨â¨x, nâ©, 0â© â p"
by blast
moreover from this and â¹pâGâº
have "â¨â¨w, nâ©, 1â© â fâGâ" "â¨â¨x, nâ©, 0â© â fâGâ" by auto
moreover from calculation
have "fâGâ ` â¨w, nâ© = 1" "fâGâ ` â¨x, nâ© = 0"
using f_G_funtype apply_equality
by auto
ultimately
have "(λnâÏ. fâGâ ` â¨w, nâ©) ` n â (λnâÏ. fâGâ ` â¨x, nâ©) ` n"
by simp
then
show ?thesis by fastforce
qed
definition
h_G :: "i" (â¹hâGââº) where
"hâGâ ⡠λαââµâ2ââMâ. λnâÏ. fâGâ`â¨Î±,nâ©"
lemma h_G_in_MG[simp]:
includes G_generic1_lemmas
shows "hâGâ â M[G]"
using ext.lam_apply_replacement ext.apply_replacement2
ext.lam_apply_replacement[unfolded lam_replacement_def]
ext.Union_closed[simplified, OF G_in_MG]
ext.nat_into_M
unfolding h_G_def
by (rule_tac ext.lam_closed[simplified] |
auto dest:transM del:ext.cexp_rel_closed[simplified])+
lemma h_G_inj_Aleph_rel2_reals: "hâGâ â injâM[G]â(âµâ2ââMâ, Ï ââM[G]â 2)"
using Aleph_rel_sub_closed
proof (intro ext.mem_inj_abs[THEN iffD2])
show "hâGâ â inj(âµâ2ââMâ, Ï ââM[G]â 2)"
unfolding inj_def
proof (intro ballI CollectI impI)
show "hâGâ â âµâ2ââMâ â Ï ââM[G]â 2"
using f_G_funtype G_in_MG ext.nat_into_M
unfolding h_G_def
apply (intro lam_type ext.mem_function_space_rel_abs[THEN iffD2], simp_all)
apply (rule_tac ext.lam_closed[simplified], simp_all)
apply (rule ext.apply_replacement2)
apply (auto dest:ext.transM[OF _ Aleph_rel_sub_closed])
done
fix w x
assume "w â âµâ2ââMâ" "x â âµâ2ââMâ" "hâGâ ` w = hâGâ ` x"
then
show "w = x"
unfolding h_G_def using Aleph_rel2_new_reals by auto
qed
qed simp_all
lemma Aleph2_extension_le_continuum_rel:
includes G_generic1_lemmas
shows "âµâ2ââM[G]â ⤠2âââµâ0ââM[G]â,M[G]â"
proof -
have "âµâ2ââMâ â M[G]" "Ord(âµâ2ââMâ)"
using Card_rel_is_Ord by auto
moreover from this
have "âµâ2ââMâ â²âM[G]â Ï ââM[G]â 2"
using ext.def_lepoll_rel[of "âµâ2ââMâ" "Ï ââM[G]â 2"]
h_G_inj_Aleph_rel2_reals by auto
moreover from calculation
have "âµâ2ââMâ â²âM[G]â |Ï ââM[G]â 2|âM[G]â"
using ext.lepoll_rel_imp_lepoll_rel_cardinal_rel by simp
ultimately
have "|âµâ2ââMâ|âM[G]â ⤠2âââµâ0ââM[G]â,M[G]â"
using ext.lepoll_rel_imp_cardinal_rel_le[of "âµâ2ââMâ" "Ï ââM[G]â 2",
OF _ _ ext.function_space_rel_closed]
ext.Aleph_rel_zero Aleph_rel_nats_MG_eq_Aleph_rel_nats_M
unfolding cexp_rel_def by simp
then
show "âµâ2ââM[G]â ⤠2âââµâ0ââM[G]â,M[G]â"
using Aleph_rel_nats_MG_eq_Aleph_rel_nats_M
ext.Card_rel_Aleph_rel[of 2, THEN ext.Card_rel_cardinal_rel_eq]
by simp
qed
lemma Aleph_rel_lt_continuum_rel: "âµâ1ââM[G]â < 2âââµâ0ââM[G]â,M[G]â"
using Aleph2_extension_le_continuum_rel
ext.Aleph_rel_increasing[of 1 2] le_trans by auto
corollary not_CH: "âµâ1ââM[G]â â 2âââµâ0ââM[G]â,M[G]â"
using Aleph_rel_lt_continuum_rel by auto
end
subsectionâ¹Models of fragments of $\ZFC + \neg \CH$âº
definition
ContHyp :: "o" where
"ContHyp â¡ âµâ1â = 2âââµâ0ââ"
relativize functional "ContHyp" "ContHyp_rel"
notation ContHyp_rel (â¹CHâ_ââº)
relationalize "ContHyp_rel" "is_ContHyp"
context M_master
begin
is_iff_rel for "ContHyp"
using is_cexp_iff is_Aleph_iff[of 0] is_Aleph_iff[of 1]
unfolding is_ContHyp_def ContHyp_rel_def
by (auto simp del:setclass_iff) (rule rexI[of _ _ M, OF _ nonempty], auto)
end
synthesize "is_ContHyp" from_definition assuming "nonempty"
arity_theorem for "is_ContHyp_fm"
notation is_ContHyp_fm (â¹â
CHâ
âº)
theorem ctm_of_not_CH:
assumes
"M â Ï" "Transset(M)" "M ⨠ZC ⪠{â
Replacement(p)â
. p â overhead}"
"Φ â formula" "M ⨠{ â
Replacement(ground_repl_fm(Ï))â
. Ï â Φ}"
shows
"âN.
M â N â§ N â Ï â§ Transset(N) â§ N ⨠ZC ⪠{â
‰
CHâ
â
} ⪠{ â
Replacement(Ï)â
. Ï â Φ} â§
(âα. Ord(α) â¶ (α â M ⷠα â N))"
proof -
from â¹M ⨠ZC ⪠{â
Replacement(p)â
. p â overhead}âº
interpret M_ZFC4 M
using M_satT_overhead_imp_M_ZF4 by simp
from â¹Transset(M)âº
interpret M_ZFC4_trans M
using M_satT_imp_M_ZF4
by unfold_locales
from â¹M â Ïâº
obtain enum where "enum â bij(Ï,M)"
using eqpoll_sym unfolding eqpoll_def by blast
then
interpret M_ctm4_AC M enum by unfold_locales
interpret cohen_data Ï "âµâ2ââMâ à Ï" 2 by unfold_locales auto
have "Add â M" "Add_le(âµâ2ââMâ) â M"
using nat_into_M Aleph_rel_closed M_nat cartprod_closed Fn_nat_closed Fnle_nat_closed
by simp_all
then
interpret forcing_data1 "Add" "Add_le(âµâ2ââMâ)" 0 M enum
by unfold_locales simp_all
obtain G where "M_generic(G)"
using generic_filter_existence[OF one_in_P]
by auto
moreover from this
interpret add_generic4 M enum G by unfold_locales
have "¬ (âµâ1ââM[G]â = 2âââµâ0ââM[G]â,M[G]â)"
using not_CH .
then
have "M[G], [] ⨠â
‰
CHâ
â
"
using ext.is_ContHyp_iff
by (simp add:ContHyp_rel_def)
then
have "M[G] ⨠ZC ⪠{â
‰
CHâ
â
}"
using ext.M_satT_ZC by auto
moreover
have "Transset(M[G])" using Transset_MG .
moreover
have "M â M[G]" using M_subset_MG[OF one_in_G] generic by simp
moreover
note â¹M ⨠{ â
Replacement(ground_repl_fm(Ï))â
. Ï â Φ}⺠â¹Î¦ â formulaâº
ultimately
show ?thesis
using Ord_MG_iff MG_eqpoll_nat satT_ground_repl_fm_imp_satT_ZF_replacement_fm[of Φ]
by (rule_tac x="M[G]" in exI, blast)
qed
lemma ZF_replacement_overhead_sub_ZFC: "{â
Replacement(p)â
. p â overhead} â ZFC"
using overhead_type unfolding ZFC_def ZF_def ZF_schemes_def by auto
corollary ctm_ZFC_imp_ctm_not_CH:
assumes
"M â Ï" "Transset(M)" "M ⨠ZFC"
shows
"âN.
M â N â§ N â Ï â§ Transset(N) â§ N ⨠ZFC ⪠{â
‰
CHâ
â
} â§
(âα. Ord(α) â¶ (α â M ⷠα â N))"
proof-
from assms
have "âN.
M â N â§
N â Ï â§
Transset(N) â§
N ⨠ZC â§ N ⨠{â
‰
CHâ
â
} â§ N ⨠{â
Replacement(x)â
. x â formula} â§ (âα. Ord(α) ⶠα â M ⷠα â N)"
using ctm_of_not_CH[of M formula] satT_ZFC_imp_satT_ZC[of M]
satT_mono[OF _ ground_repl_fm_sub_ZFC, of M]
satT_mono[OF _ ZF_replacement_overhead_sub_ZFC, of M]
satT_mono[OF _ ZF_replacement_fms_sub_ZFC, of M]
by (simp add: satT_Un_iff)
then
obtain N where "N ⨠ZC" "N ⨠{â
‰
CHâ
â
}" "N ⨠{â
Replacement(x)â
. x â formula}"
"M â N" "N â Ï" "Transset(N)" "(âα. Ord(α) ⶠα â M ⷠα â N)"
by auto
moreover from this
have "N ⨠ZFC"
using satT_ZC_ZF_replacement_imp_satT_ZFC
by auto
moreover from this and â¹N ⨠{â
‰
CHâ
â
}âº
have "N ⨠ZFC ⪠{â
‰
CHâ
â
}"
by auto
ultimately
show ?thesis by auto
qed
endd>
Theory Kappa_Closed_Notions
sectionâ¹Preservation results for $\kappa$-closed forcing notionsâº
theory Kappa_Closed_Notions
imports
Not_CH
begin
definition
lerel :: "iâi" where
"lerel(α) ⡠Memrel(α) ⪠id(α)"
lemma lerelI[intro!]: "xâ¤y â¹ yâα â¹ Ord(α) â¹ â¨x,yâ© â lerel(α)"
using Ord_trans[of x y α] ltD unfolding lerel_def by auto
lemma lerelD[dest]: "â¨x,yâ© â lerel(α) â¹ Ord(α) â¹ xâ¤y"
using ltI[THEN leI] Ord_in_Ord unfolding lerel_def by auto
definition
mono_seqspace :: "[i,i,i] â i" (â¹_ â©<â '(_,_')⺠[61] 60) where
"α â©<â (P,leq) â¡ mono_map(α,Memrel(α),P,leq)"
relativize functional "mono_seqspace" "mono_seqspace_rel"
relationalize "mono_seqspace_rel" "is_mono_seqspace"
synthesize "is_mono_seqspace" from_definition assuming "nonempty"
context M_ZF_library
begin
rel_closed for "mono_seqspace"
unfolding mono_seqspace_rel_def mono_map_rel_def
using separation_closed separation_ball separation_imp separation_in
lam_replacement_fst lam_replacement_snd lam_replacement_hcomp lam_replacement_constant
lam_replacement_Pair[THEN[5] lam_replacement_hcomp2]
lam_replacement_apply2[THEN[5] lam_replacement_hcomp2]
by simp_all
end
abbreviation
mono_seqspace_r (â¹_ â©<ââ_â '(_,_')⺠[61] 60) where
"α â©<ââMâ (P,leq) â¡ mono_seqspace_rel(M,α,P,leq)"
abbreviation
mono_seqspace_r_set (â¹_ â©<ââ_â '(_,_')⺠[61] 60) where
"α â©<ââMâ (P,leq) â¡ mono_seqspace_rel(##M,α,P,leq)"
lemma mono_seqspaceI[intro!]:
includes mono_map_rules
assumes "f: AâP" "âx y. xâA â¹ yâA â¹ x<y â¹ â¨f`x, f`yâ© â leq" "Ord(A)"
shows "f: A â©<â (P,leq)"
using ltI[OF _ Ord_in_Ord[of A], THEN [3] assms(2)] assms(1,3)
unfolding mono_seqspace_def by auto
lemma (in M_ZF_library) mono_seqspace_rel_char:
assumes "M(A)" "M(P)" "M(leq)"
shows "A â©<ââMâ (P,leq) = {fâA â©<â (P,leq). M(f)}"
using assms mono_map_rel_char
unfolding mono_seqspace_def mono_seqspace_rel_def by simp
lemma (in M_ZF_library) mono_seqspace_relI[intro!]:
assumes "f: AââMâ P" "âx y. xâA â¹ yâA â¹ x<y â¹ â¨f`x, f`yâ© â leq"
"Ord(A)" "M(A)" "M(P)" "M(leq)"
shows "f: A â©<ââMâ (P,leq)"
using mono_seqspace_rel_char function_space_rel_char assms by auto
lemma mono_seqspace_is_fun[dest]:
includes mono_map_rules
shows "j: A â©<â (P,leq) â¹ j: Aâ P"
unfolding mono_seqspace_def by auto
lemma mono_map_lt_le_is_mono[dest]:
includes mono_map_rules
assumes "j: A â©<â (P,leq)" "aâA" "câA" "aâ¤c" "Ord(A)" "refl(P,leq)"
shows "â¨j`a,j`câ© â leq"
using assms mono_map_increasing unfolding mono_seqspace_def refl_def
by (cases "a=c") (auto dest:ltD)
lemma (in M_ZF_library) mem_mono_seqspace_abs[absolut]:
assumes "M(f)" "M(A)" "M(P)" "M(leq)"
shows "f:A â©<ââMâ (P,leq) â· f: A â©<â (P,leq)"
using assms mono_map_rel_char unfolding mono_seqspace_def mono_seqspace_rel_def
by (simp)
definition
mono_map_lt_le :: "[i,i] â i" (infixr â¹â©<ââ©â¤âº 60) where
"α â©<ââ©â¤ β ⡠α â©<â (β,lerel(β))"
lemma mono_map_lt_leI[intro!]:
includes mono_map_rules
assumes "f: AâB" "âx y. xâA â¹ yâA â¹ x<y â¹ f`x ⤠f`y" "Ord(A)" "Ord(B)"
shows "f: A â©<ââ©â¤ B"
using assms
unfolding mono_map_lt_le_def by auto
definition
kappa_closed :: "[i,i,i] â o" (â¹_-closed'(_,_')âº) where
"κ-closed(P,leq) â¡ âδ. δ<κ â¶ (âfâδ â©<â (P,converse(leq)). âqâP. âαâδ. â¨q,f`αâ©âleq)"
relativize functional "kappa_closed" "kappa_closed_rel"
relationalize "kappa_closed_rel" "is_kappa_closed"
synthesize "is_kappa_closed" from_definition assuming "nonempty"
abbreviation
kappa_closed_r (â¹_-closedâ_â'(_,_')⺠[61] 60) where
"κ-closedâMâ(P,leq) â¡ kappa_closed_rel(M,κ,P,leq)"
abbreviation
kappa_closed_r_set (â¹_-closedâ_â'(_,_')⺠[61] 60) where
"κ-closedâMâ(P,leq) â¡ kappa_closed_rel(##M,κ,P,leq)"
lemma (in forcing_data4) forcing_a_value:
assumes "p â© â
0:1â2â
[f_dot, Aâ§v, Bâ§v]" "a â A"
"q â¼ p" "q â P" "pâP" "f_dot â M" "AâM" "BâM"
shows "âdâP. âbâB. d â¼ q â§ d â© â
0`1 is 2â
[f_dot, aâ§v, bâ§v]"
proof -
from assms
have "q â© â
0:1â2â
[f_dot, Aâ§v, Bâ§v]"
using strengthening_lemma[of p "â
0:1â2â
" q "[f_dot, Aâ§v, Bâ§v]"]
typed_function_type arity_typed_function_fm
by (auto simp: union_abs2 union_abs1 check_in_M P_in_M)
from â¹aâA⺠â¹AâMâº
have "aâM" by (auto dest:transM)
from â¹qâPâº
textâ¹Here we're using countability (via the existence of generic filters)
of \<^term>â¹M⺠as a shortcut, to avoid a further density argument.âº
obtain G where "M_generic(G)" "qâG"
using generic_filter_existence by blast
then
interpret G_generic4_AC _ _ _ _ _ G by unfold_locales
include G_generic1_lemmas
note â¹qâGâº
moreover
note â¹q â© â
0:1â2â
[f_dot, Aâ§v, Bâ§v]⺠â¹M_generic(G)âº
moreover
note â¹qâP⺠â¹f_dotâM⺠â¹BâM⺠â¹AâMâº
moreover from this
have "map(val(P, G), [f_dot, Aâ§v, Bâ§v]) â list(M[G])" by simp
moreover from calculation
have "val(P,G,f_dot) : A ââM[G]â B"
using truth_lemma[of "â
0:1â2â
" G "[f_dot, Aâ§v, Bâ§v]", THEN iffD1]
typed_function_type arity_typed_function_fm valcheck[OF one_in_G one_in_P]
by (auto simp: union_abs2 union_abs1 ext.mem_function_space_rel_abs)
moreover
note â¹a â Mâº
moreover from calculation and â¹aâAâº
have "val(P,G,f_dot) ` a â B" (is "?b â B")
by (simp add: ext.mem_function_space_rel_abs)
moreover from calculation
have "?b â M" by (auto dest:transM)
moreover from calculation
have "M[G], map(val(P,G), [f_dot, aâ§v, ?bâ§v]) ⨠â
0`1 is 2â
"
by simp
moreover
note â¹M_generic(G)âº
ultimately
obtain r where "r â© â
0`1 is 2â
[f_dot, aâ§v, ?bâ§v]" "râG" "râP"
using truth_lemma[of "â
0`1 is 2â
" G "[f_dot, aâ§v, ?bâ§v]", THEN iffD2]
fun_apply_type arity_fun_apply_fm valcheck[OF one_in_G one_in_P]
by (auto simp: union_abs2 union_abs1 ext.mem_function_space_rel_abs)
moreover from this and â¹qâGâº
obtain d where "dâ¼q" "dâ¼r" "dâP" by force
moreover
note â¹f_dotâM⺠â¹aâM⺠â¹?bâB⺠â¹BâMâº
moreover from calculation
have "d â¼ q â§ d â© â
0`1 is 2â
[f_dot, aâ§v, ?bâ§v]"
using fun_apply_type arity_fun_apply_fm
strengthening_lemma[of r "â
0`1 is 2â
" d "[f_dot, aâ§v, ?bâ§v]"]
by (auto dest:transM simp add: union_abs2 union_abs1)
ultimately
show ?thesis by auto
qed
context G_generic4_AC begin
context
includes G_generic1_lemmas
begin
lemma separation_check_snd_aux:
assumes "f_dotâM" "ÏâM" "Ïâformula" "arity(Ï) ⤠7"
shows "separation(##M, λr. M, [fst(r), P, leq, ð, f_dot, Ï, snd(r)â§v] ⨠Ï)"
proof -
note types = assms leq_in_M P_in_M one_in_M
let ?f_fm="fst_fm(1,0)"
let ?g_fm="hcomp_fm(check_fm'(6),snd_fm,2,0)"
have "?f_fm â formula" "arity(?f_fm) ⤠7" "?g_fm â formula" "arity(?g_fm) ⤠8"
using ord_simp_union
unfolding hcomp_fm_def check_fm'_def
by (simp_all add:arity)
then
show ?thesis
using separation_sat_after_function assms types
using fst_abs snd_abs types sats_snd_fm sats_check_fm check_abs check_in_M
unfolding hcomp_fm_def check_fm'_def
by simp
qed
lemma separation_check_fst_snd_aux :
assumes "f_dotâM" "râM" "Ïâformula" "arity(Ï) ⤠7"
shows "separation(##M, λp. M, [r, P, leq, ð, f_dot, fst(p)â§v, snd(p)â§v] ⨠Ï)"
proof -
let ?Ï="λz. [r, P, leq, ð, f_dot, fst(z)â§v, snd(z)â§v]"
let ?Ï'="λz. [fst(z)â§v, P, leq, ð, f_dot, r, snd(z)â§v]"
let ?Ï=" (â
â(â
â(â
â(â
â(â
â(â
ââ
â
0 = 11â
â§ â
â
1 = 7â
â§ â
â
2 = 8â
â§ â
â
3 = 9â
â§ â
â
4 = 10â
â§ â
â
5 = 6â
â§
(λp. incr_bv(p)`6)^6 (Ï) â
â
â
â
â
â
â
)â
)â
)â
)â
)â
)"
note types = assms leq_in_M P_in_M one_in_M
let ?f_fm="hcomp_fm(check_fm'(5),fst_fm,1,0)"
let ?g_fm="hcomp_fm(check_fm'(6),snd_fm,2,0)"
have "?f_fm â formula" "arity(?f_fm) ⤠7" "?g_fm â formula" "arity(?g_fm) ⤠8"
using ord_simp_union
unfolding hcomp_fm_def check_fm'_def
by (simp_all add:arity)
moreover from assms
have fm:"?Ïâformula" by simp
moreover from â¹Ï â formula⺠â¹arity(Ï) ⤠7âº
have "arity(Ï) = 0 ⨠arity(Ï) = 1 ⨠arity(Ï) = 2 ⨠arity(Ï) = 3
⨠arity(Ï) = 4 ⨠arity(Ï) = 5 ⨠arity(Ï) = 6 ⨠arity(Ï) = 7"
unfolding lt_def by auto
with calculation and â¹Ï â formulaâº
have ar:"arity(?Ï) ⤠7"
using arity_incr_bv_lemma by safe (simp_all add: arity ord_simp_union)
moreover from calculation
have sep:"separation(##M,λz. M,?Ï'(z)â¨?Ï)"
using separation_sat_after_function assms types sats_check_fm check_abs check_in_M
fst_abs snd_abs
unfolding hcomp_fm_def check_fm'_def
by simp
moreover
have "?Ï(z) â list(M)" if "(##M)(z)" for z
using types that by simp
moreover from calculation and â¹r â M⺠â¹Ï â formulaâº
have "(M,?Ï(z) ⨠Ï) â· (M,?Ï'(z)â¨?Ï)" if "(##M)(z)" for z
using that types sats_incr_bv_iff[of _ _ M _ "[_,_,_,_,_,_]"]
by simp
ultimately
show ?thesis using separation_cong[THEN iffD1,OF _ sep]
by simp
qed
lemma separation_leq_and_forces_apply_aux:
assumes "f_dotâM" "BâM"
shows "ânâM. separation(##M, λx. snd(x) â¼ fst(x) â§
(âbâB. M, [snd(x), P, leq, ð, f_dot, (â(n))â§v, bâ§v] ⨠forces(â
0`1 is 2â
)))"
proof -
have pred_nat_closed: "pred(n)âM" if "nâM" for n
using nat_case_closed that
unfolding pred_def
by auto
have "separation(##M, λz. M, [snd(fst(z)), P, leq, ð, f_dot, Ï, snd(z)â§v] ⨠Ï)"
if "Ïâformula" "arity(Ï) ⤠7" "ÏâM" for Ï Ï
proof -
note types = assms leq_in_M P_in_M one_in_M
let ?f_fm="hcomp_fm(snd_fm,fst_fm,1,0)"
let ?g_fm="hcomp_fm(check_fm'(6),snd_fm,2,0)"
have "?f_fm â formula" "arity(?f_fm) ⤠7" "?g_fm â formula" "arity(?g_fm) ⤠8"
using ord_simp_union
unfolding hcomp_fm_def check_fm'_def
by (simp_all add:arity)
then
show ?thesis
using separation_sat_after_function assms types sats_check_fm check_abs fst_abs snd_abs that
unfolding hcomp_fm_def check_fm'_def
by simp
qed
then
show ?thesis
using P_in_M assms
separation_in lam_replacement_constant lam_replacement_snd lam_replacement_fst
lam_replacement_Pair[THEN[5] lam_replacement_hcomp2] leq_in_M check_in_M pred_nat_closed
arity_forces[of " â
0`1 is 2â
"] arity_fun_apply_fm[of 0 1 2] ord_simp_union
by(clarify, rule_tac separation_conj,simp_all,rule_tac separation_bex,simp_all)
qed
lemma separation_ball_leq_and_forces_apply_aux:
assumes "f_dotâM" "pâM" "BâM"
shows "separation
(##M,
λpa. âxâP. x â¼ p â¶
(âyâP. y â¼ p â¶
â¨x, yâ© â snd(pa) â·
y â¼ x â§ (âbâB. M, [y, P, leq, ð, f_dot, (â(fst(pa)))â§v, bâ§v] ⨠forces(â
0`1 is 2â
))))"
proof -
have "separation(##M, λz. M, [snd(fst(z)), P, leq, ð, f_dot, (â(fst(fst(fst(fst(z))))))â§v, snd(z)â§v] ⨠Ï)"
if "Ïâformula" "arity(Ï) ⤠7" for Ï
proof -
note types = assms leq_in_M P_in_M one_in_M
let ?f_fm="hcomp_fm(snd_fm,fst_fm,1,0)"
let ?g="λz . (â(fst(fst(fst(fst(z))))))â§v"
let ?g_fm="hcomp_fm(check_fm'(6),hcomp_fm(big_union_fm,hcomp_fm(fst_fm,hcomp_fm(fst_fm,hcomp_fm(fst_fm,fst_fm)))),2,0)"
let ?h_fm="hcomp_fm(check_fm'(7),snd_fm,3,0)"
have f_fm_facts:"?f_fm â formula" "arity(?f_fm) ⤠6"
using ord_simp_union
unfolding hcomp_fm_def
by (simp_all add:arity)
moreover from types
have "?g_fm â formula" "arity(?g_fm) ⤠7" "?h_fm â formula" "arity(?h_fm) ⤠8"
using ord_simp_union
unfolding hcomp_fm_def check_fm'_def
by (simp_all add:arity)
ultimately
show ?thesis
using separation_sat_after_function3[OF _ _ _ f_fm_facts] check_abs
types assms sats_check_fm that fst_abs snd_abs
unfolding hcomp_fm_def check_fm'_def
by simp
qed
then
show ?thesis
using P_in_M leq_in_M assms
separation_ball separation_imp separation_conj separation_bex separation_in separation_iff'
lam_replacement_constant lam_replacement_identity lam_replacement_hcomp
lam_replacement_fst lam_replacement_snd
lam_replacement_Pair[THEN[5] lam_replacement_hcomp2]
lam_replacement_hcomp[OF
lam_replacement_hcomp[OF lam_replacement_fst lam_replacement_fst]
lam_replacement_snd]
arity_forces[of " â
0`1 is 2â
"] arity_fun_apply_fm[of 0 1 2] ord_simp_union
separation_in[OF _ lam_replacement_Pair[THEN[5] lam_replacement_hcomp2]]
by simp
qed
lemma separation_closed_leq_and_forces_eq_check_aux :
assumes "AâM" "râG" "Ï â M"
shows "(##M)({qâP. âhâA. q â¼ r â§ q â© â
0 = 1â
[Ï, hâ§v]})"
proof -
have "separation(##M, λz. M, [fst(z), P, leq, ð, Ï, snd(z)â§v] ⨠Ï)" if
"Ïâformula" "arity(Ï) ⤠6" for Ï
proof -
let ?f_fm="fst_fm(1,0)"
let ?g_fm="hcomp_fm(check_fm'(6),snd_fm,2,0)"
note types = assms leq_in_M P_in_M one_in_M
moreover
have "?f_fm â formula" "arity(?f_fm) ⤠6" "?g_fm â formula" "arity(?g_fm) ⤠7"
using ord_simp_union
unfolding hcomp_fm_def check_fm'_def
by (simp_all add:arity)
ultimately
show ?thesis
using separation_sat_after_function_1 assms sats_fst_fm that
fst_abs snd_abs types sats_snd_fm sats_check_fm check_abs check_in_M
unfolding hcomp_fm_def check_fm'_def
by simp
qed
then
show ?thesis
using separation_conj separation_in
lam_replacement_constant lam_replacement_fst
lam_replacement_Pair[THEN[5] lam_replacement_hcomp2]
assms leq_in_M G_subset_M[THEN subsetD] generic
arity_forces[of "â
0 = 1â
",simplified] ord_simp_union
by(rule_tac separation_closed[OF separation_bex],simp_all)
qed
lemma separation_closed_forces_apply_aux:
assumes "BâM" "f_dotâM" "râM"
shows "(##M)({â¨n,bâ© â Ï Ã B. r â© â
0`1 is 2â
[f_dot, nâ§v, bâ§v]})"
using nat_in_M assms check_in_M transitivity[OF _ â¹BâMâº] nat_into_M separation_check_fst_snd_aux
arity_forces[of " â
0`1 is 2â
"] arity_fun_apply_fm[of 0 1 2] ord_simp_union
unfolding split_def
by simp_all
lemma kunen_IV_6_9_function_space_rel_eq:
assumes "âp Ï. p â© â
0:1â2â
[Ï, Aâ§v, Bâ§v] â¹ pâP â¹ Ï â M â¹
âqâP. âhâA ââMâ B. q â¼ p â§ q â© â
0 = 1â
[Ï, hâ§v]" "AâM" "BâM"
shows
"A ââMâ B = A ââM[G]â B"
proof (intro equalityI; clarsimp simp add:
assms function_space_rel_char ext.function_space_rel_char)
fix f
assume "f â A â B" "f â M[G]"
moreover from this
obtain Ï where "val(P,G,Ï) = f" "Ï â M"
using GenExtD by force
moreover from calculation and â¹AâM⺠â¹BâMâº
obtain r where "r â© â
0:1â2â
[Ï, Aâ§v, Bâ§v]" "râG"
using truth_lemma[of "â
0:1â2â
" G "[Ï, Aâ§v, Bâ§v]"] generic
typed_function_type arity_typed_function_fm valcheck[OF one_in_G one_in_P]
by (auto simp: union_abs2 union_abs1)
moreover from â¹AâM⺠â¹BâM⺠â¹râG⺠â¹Ï â Mâº
have "{qâP. âhâA ââMâ B. q â¼ r â§ q â© â
0 = 1â
[Ï, hâ§v]} â M" (is "?D â M")
using separation_closed_leq_and_forces_eq_check_aux by auto
moreover from calculation and assms(2-)
have "dense_below(?D, r)"
using strengthening_lemma[of r "â
0:1â2â
" _ "[Ï, Aâ§v, Bâ§v]", THEN assms(1)[of _ Ï]]
leq_transD generic_dests(1)[of r]
by (auto simp: union_abs2 union_abs1 typed_function_type arity_typed_function_fm) blast
moreover from calculation
obtain q h where "hâA ââMâ B" "q â© â
0 = 1â
[Ï, hâ§v]" "q â¼ r" "qâP" "qâG"
using generic_inter_dense_below[of ?D G r, OF _ generic] by blast
note â¹q â© â
0 = 1â
[Ï, hâ§v]⺠â¹ÏâM⺠â¹hâA ââMâ B⺠â¹AâM⺠â¹BâM⺠â¹qâGâº
moreover from this
have "map(val(P, G), [Ï, hâ§v]) â list(M[G])" "hâM"
by (auto dest:transM)
ultimately
have "h = f"
using truth_lemma[of "â
0=1â
" G "[Ï, hâ§v]"] generic valcheck[OF one_in_G one_in_P]
by (auto simp: ord_simp_union)
with â¹hâMâº
show "f â M" by simp
qed
subsectionâ¹$(\omega+1)$-Closed notions preserve countable sequencesâº
lemma succ_omega_closed_imp_no_new_nat_sequences:
assumes "succ(Ï)-closedâMâ(P,leq)" "f : Ï â B" "fâM[G]" "BâM"
shows "fâM"
proof -
txtâ¹The next long block proves that the assumptions of Lemma
@{thm [source] kunen_IV_6_9_function_space_rel_eq} are satisfied.âº
{
fix p f_dot
assume "p â© â
0:1â2â
[f_dot, Ïâ§v, Bâ§v]" "pâP" "f_dotâM"
let ?subp="{qâP. q â¼ p}"
from â¹pâPâº
have "?subp â M"
using first_section_closed[of P p "converse(leq)"] leq_in_M P_in_M
by (auto dest:transM)
define S where "S ⡠λnânat.
{â¨q,râ© â ?subpÃ?subp. r â¼ q â§ (âbâB. r â© â
0`1 is 2â
[f_dot, (â(n))â§v, bâ§v])}"
(is "S ⡠λnânat. ?Y(n)")
define S' where "S' ⡠λnânat.
{â¨q,râ© â ?subpÃ?subp. r â¼ q â§ (âbâB. r â© â
0`1 is 2â
[f_dot, (pred(n))â§v, bâ§v])}"
moreover
have "S = S'"
unfolding S_def S'_def using pred_nat_eq lam_cong by auto
moreover from â¹BâM⺠â¹?subpâM⺠â¹f_dotâMâº
have "{r â ?subp. âbâB. r â© â
0`1 is 2â
[f_dot, (â(n))â§v, bâ§v]} â M" (is "?X(n) â M")
if "nâÏ" for n
using that separation_check_snd_aux nat_into_M ord_simp_union
arity_forces[of " â
0`1 is 2â
"] arity_fun_apply_fm
by(rule_tac separation_closed[OF separation_bex,simplified], simp_all)
moreover
have "?Y(n) = (?subp à ?X(n)) ⩠converse(leq)" for n
by (intro equalityI) auto
moreover
note â¹?subp â M⺠â¹BâM⺠â¹pâP⺠â¹f_dotâMâº
moreover from calculation
have "n â Ï â¹ ?Y(n) â M" for n
using nat_into_M leq_in_M by simp
moreover from calculation
have "S â M"
using separation_ball_leq_and_forces_apply_aux separation_leq_and_forces_apply_aux
transitivity[OF â¹pâP⺠P_in_M]
unfolding S_def split_def
by(rule_tac lam_replacement_Collect[THEN lam_replacement_imp_lam_closed,simplified], simp_all)
ultimately
have "S' â M"
by simp
from â¹pâP⺠â¹f_dotâM⺠â¹p â© â
0:1â2â
[f_dot, Ïâ§v, Bâ§v]⺠â¹BâMâº
have exr:"ârâP. r â¼ q â§ (âbâB. r â© â
0`1 is 2â
[f_dot, pred(n)â§v, bâ§v])"
if "q â¼ p" "qâP" "nâÏ" for q n
using that forcing_a_value by (auto dest:transM)
have "âqâ?subp. ânâÏ. ârâ?subp. â¨q,râ© â S'`n"
proof -
{
fix q n
assume "q â ?subp" "nâÏ"
moreover from this
have "q â¼ p" "q â P" "pred(n) = ân"
using pred_nat_eq by simp_all
moreover from calculation and exr
obtain r where MM:"r â¼ q" "âbâB. r â© â
0`1 is 2â
[f_dot, pred(n)â§v, bâ§v]" "râP"
by blast
moreover from calculation â¹q â¼ p⺠â¹p â Pâº
have "r â¼ p"
using leq_transD[of r q p] by auto
ultimately
have "ârâ?subp. r â¼ q â§ (âbâB. r â© â
0`1 is 2â
[f_dot, (pred(n))â§v, bâ§v])"
by auto
}
then
show ?thesis
unfolding S'_def by simp
qed
with â¹pâP⺠â¹?subp â M⺠â¹S' â Mâº
obtain g where "g â Ï ââMâ ?subp" "g`0 = p" "ân â nat. â¨g`n,g`succ(n)â©âS'`succ(n)"
using sequence_DC[simplified] refl_leq[of p] by blast
moreover from this and â¹?subp â Mâº
have "g : Ï â P" "g â M"
using fun_weaken_type[of g Ï ?subp P] function_space_rel_char by auto
ultimately
have "g : Ï â©<ââMâ (P,converse(leq))"
using decr_succ_decr[of g] leq_preord leq_in_M P_in_M
unfolding S'_def by (auto simp:absolut intro:leI)
moreover from â¹succ(Ï)-closedâMâ(P,leq)⺠and this
have "âqâM. q â P â§ (âαâM. α â Ï â¶ q â¼ g ` α)"
using transM[simplified, of g] leq_in_M
mono_seqspace_rel_closed[of Ï _ "converse(leq)"]
unfolding kappa_closed_rel_def
by auto
ultimately
obtain r where "râP" "râM" "ânâÏ. r â¼ g`n"
using nat_into_M by auto
with â¹g`0 = pâº
have "r â¼ p"
by blast
let ?h="{â¨n,bâ© â Ï Ã B. r â© â
0`1 is 2â
[f_dot, nâ§v, bâ§v]}"
have "function(?h)"
proof (rule_tac functionI, rule_tac ccontr, auto simp del: app_Cons)
fix n b b'
assume "n â Ï" "b â b'" "b â B" "b' â B"
moreover
assume "r â© â
0`1 is 2â
[f_dot, nâ§v, bâ§v]" "r â© â
0`1 is 2â
[f_dot, nâ§v, b'â§v]"
moreover
note â¹r â Pâº
moreover from this
have "¬ r ⥠r"
by (auto intro!:refl_leq)
moreover
note â¹f_dotâM⺠â¹BâMâº
ultimately
show False
using forces_neq_apply_imp_incompatible[of r f_dot "nâ§v" b r b']
transM[of _ B] by (auto dest:transM)
qed
moreover
have "range(?h) â B"
by auto
moreover
have "domain(?h) = Ï"
proof -
{
fix n
assume "n â Ï"
moreover from this
have 1:"(â(n)) = pred(n)"
using pred_nat_eq by simp
moreover from calculation and â¹ân â nat. â¨g`n,g`succ(n)â©âS'`succ(n)âº
obtain b where "g`(succ(n)) â© â
0`1 is 2â
[f_dot, nâ§v, bâ§v]" "bâB"
unfolding S'_def by auto
moreover from â¹BâM⺠and calculation
have "b â M" "n â M"
by (auto dest:transM)
moreover
note â¹g : Ï â P⺠â¹ânâÏ. r â¼ g`n⺠â¹râP⺠â¹f_dotâMâº
moreover from calculation
have "r â© â
0`1 is 2â
[f_dot, nâ§v, bâ§v]"
using fun_apply_type arity_fun_apply_fm
strengthening_lemma[of "g`succ(n)" "â
0`1 is 2â
" r "[f_dot, nâ§v, bâ§v]"]
by (simp add: union_abs2 union_abs1)
ultimately
have "âbâB. r â© â
0`1 is 2â
[f_dot, nâ§v, bâ§v]"
by auto
}
then
show ?thesis
by force
qed
moreover
have "relation(?h)"
unfolding relation_def by simp
moreover from â¹f_dotâM⺠â¹râM⺠â¹BâMâº
have "?h â M"
using separation_closed_forces_apply_aux by simp
moreover
note â¹B â Mâº
ultimately
have "?h: Ï ââMâ B"
using function_imp_Pi[THEN fun_weaken_type[of ?h _ "range(?h)" B]]
function_space_rel_char by simp
moreover
note â¹p â© â
0:1â2â
[f_dot, Ïâ§v, Bâ§v]⺠â¹r â¼ p⺠â¹râP⺠â¹pâP⺠â¹f_dotâM⺠â¹BâMâº
moreover from this
have "r â© â
0:1â2â
[f_dot, Ïâ§v, Bâ§v]"
using strengthening_lemma[of p "â
0:1â2â
" r "[f_dot, Ïâ§v, Bâ§v]"]
typed_function_type arity_typed_function_fm
by (auto simp: union_abs2 union_abs1)
moreover
note â¹?hâMâº
moreover from calculation
have "r â© â
0 = 1â
[f_dot, ?hâ§v]"
proof (intro definition_of_forcing[THEN iffD2] allI impI,
simp_all add:union_abs2 union_abs1 del:app_Cons)
fix G
let ?f="val(P,G,f_dot)"
assume "M_generic(G) â§ r â G"
moreover from this
interpret g:G_generic1 _ _ _ _ _ G
by unfold_locales simp
note â¹râP⺠â¹f_dotâM⺠â¹BâMâº
moreover from this
have "map(val(P, G), [f_dot, Ïâ§v, Bâ§v]) â list(M[G])"
by simp
moreover from calculation and â¹r â© â
0:1â2â
[f_dot, Ïâ§v, Bâ§v]âº
have "?f : Ï â B"
using truth_lemma[of "â
0:1â2â
" G "[f_dot, Ïâ§v, Bâ§v]"] one_in_G one_in_P
typed_function_type arity_typed_function_fm valcheck
by (auto simp: union_abs2 union_abs1)
moreover
have "?h`n = ?f`n" if "n â Ï" for n
proof -
note â¹n â Ï⺠â¹domain(?h) = Ïâº
moreover from this
have "nâdomain(?h)"
by simp
moreover from this
obtain b where "r â© â
0`1 is 2â
[f_dot, nâ§v, bâ§v]" "bâB"
by force
moreover
note â¹function(?h)âº
moreover from calculation
have "b = ?h`n"
using function_apply_equality by simp
moreover
note â¹B â Mâº
moreover from calculation
have "?h`n â M"
by (auto dest:transM)
moreover
note â¹f_dot â M⺠â¹r â P⺠â¹M_generic(G) â§ r â G⺠â¹map(val(P, G), [f_dot, Ïâ§v, Bâ§v]) â list(M[G])âº
moreover from calculation
have "[?f, n, ?h`n] â list(M[G])"
using M_subset_MG nat_into_M[of n] one_in_G by (auto dest:transM)
ultimately
show ?thesis
using definition_of_forcing[of r "â
0`1 is 2â
" "[f_dot, nâ§v, bâ§v]",
THEN iffD1, rule_format, of G]
valcheck one_in_G one_in_P nat_into_M
by (auto dest:transM simp add:fun_apply_type
arity_fun_apply_fm union_abs2 union_abs1)
qed
with calculation and â¹BâM⺠â¹?h: Ï ââMâ Bâº
have "?h = ?f"
using function_space_rel_char
by (rule_tac fun_extension[of ?h Ï "λ_.B" ?f]) auto
ultimately
show "?f = val(P, G, ?hâ§v)"
using valcheck one_in_G one_in_P generic by simp
qed
ultimately
have "ârâP. âhâÏ ââMâ B. r â¼ p â§ r â© â
0 = 1â
[f_dot, hâ§v]"
by blast
}
moreover
note â¹B â M⺠assms
moreover from calculation
have "f : Ï ââMâ B"
using kunen_IV_6_9_function_space_rel_eq function_space_rel_char
ext.mem_function_space_rel_abs by auto
ultimately
show ?thesis
by (auto dest:transM)
qed
declare mono_seqspace_rel_closed[rule del]
lemma succ_omega_closed_imp_no_new_reals:
assumes "succ(Ï)-closedâMâ(P,leq)"
shows "Ï ââMâ 2 = Ï ââM[G]â 2"
proof -
from assms
have "Ï ââM[G]â 2 â Ï ââMâ 2"
using succ_omega_closed_imp_no_new_nat_sequences function_space_rel_char
ext.function_space_rel_char Aleph_rel_succ Aleph_rel_zero
by auto
then
show ?thesis
using function_space_rel_transfer by (intro equalityI) auto
qed
lemma succ_omega_closed_imp_Aleph_1_preserved:
assumes "succ(Ï)-closedâMâ(P,leq)"
shows "âµâ1ââMâ = âµâ1ââM[G]â"
proof -
have "âµâ1ââM[G]â ⤠âµâ1ââMâ"
proof (rule ccontr)
assume "¬ âµâ1ââM[G]â ⤠âµâ1ââMâ"
then
have "âµâ1ââMâ < âµâ1ââM[G]â"
using Card_rel_is_Ord ext.Card_rel_is_Ord
not_le_iff_lt[THEN iffD1] by auto
then
have "|âµâ1ââMâ|âM[G]â ⤠Ï"
using ext.Card_rel_lt_csucc_rel_iff ext.Aleph_rel_zero
ext.Aleph_rel_succ ext.Card_rel_nat
by (auto intro!:ext.lt_csucc_rel_iff[THEN iffD1]
intro:Card_rel_Aleph_rel[THEN Card_rel_is_Ord, of 1])
then
obtain f where "f â inj(âµâ1ââMâ,Ï)" "f â M[G]"
using ext.countable_rel_iff_cardinal_rel_le_nat[of "âµâ1ââMâ", THEN iffD2]
unfolding countable_rel_def lepoll_rel_def
by auto
then
obtain g where "g â surjâM[G]â(Ï, âµâ1ââMâ)"
using ext.inj_rel_imp_surj_rel[of f _ Ï, OF _ zero_lt_Aleph_rel1[THEN ltD]]
by auto
moreover from this
have "g : Ï â âµâ1ââMâ" "g â M[G]"
using ext.surj_rel_char surj_is_fun by simp_all
moreover
note â¹succ(Ï)-closedâMâ(P,leq)âº
ultimately
have "g â surjâMâ(Ï, âµâ1ââMâ)" "g â M"
using succ_omega_closed_imp_no_new_nat_sequences
mem_surj_abs ext.mem_surj_abs by simp_all
then
show False
using surj_rel_implies_cardinal_rel_le[of g Ï "âµâ1ââMâ"]
Card_rel_nat[THEN Card_rel_cardinal_rel_eq] Card_rel_is_Ord
not_le_iff_lt[THEN iffD2, OF _ _ nat_lt_Aleph_rel1]
by simp
qed
then
show ?thesis
using Aleph_rel_le_Aleph_rel
by (rule_tac le_anti_sym) simp
qed
end
end
endlass="head">
Theory CH
sectionâ¹Forcing extension satisfying the Continuum Hypothesisâº
theory CH
imports
Kappa_Closed_Notions
Cohen_Posets_Relative
begin
context M_ctm3_AC
begin
declare Fn_rel_closed[simp del, rule del, simplified setclass_iff, simp, intro]
declare Fnle_rel_closed[simp del, rule del, simplified setclass_iff, simp, intro]
abbreviation
Coll :: "i" where
"Coll â¡ FnâMâ(âµâ1ââMâ, âµâ1ââMâ, Ï ââMâ 2)"
abbreviation
Colleq :: "i" where
"Colleq â¡ FnleâMâ(âµâ1ââMâ, âµâ1ââMâ, Ï ââMâ 2)"
lemma Coll_in_M[intro,simp]: "Coll â M" by simp
lemma Colleq_refl : "refl(Coll,Colleq)"
unfolding Fnle_rel_def Fnlerel_def refl_def
using RrelI by simp
subsectionâ¹Collapse forcing is sufficiently closedâº
lemma succ_omega_closed_Coll: "succ(Ï)-closedâMâ(Coll,Colleq)"
proof -
have "nâÏ â¹ âf â n â©<ââMâ (Coll,converse(Colleq)).
âqâM. q â Coll â§ (âαâM. α â n â¶ â¨q, f ` α⩠â Colleq)" for n
proof (induct rule:nat_induct)
case 0
then
show ?case
using zero_lt_Aleph_rel1 zero_in_Fn_rel
by (auto simp del:setclass_iff) (rule bexI[OF _ zero_in_M], auto)
next
case (succ x)
then
have "âfâsucc(x) â©<ââMâ (Coll,converse(Colleq)). âα â succ(x). â¨f`x, f ` α⩠â Colleq"
proof(intro ballI)
fix f α
assume "fâsucc(x) â©<ââMâ (Coll,converse(Colleq))" "αâsucc(x)"
moreover from â¹xâÏ⺠this
have "fâsucc(x) â©<â (Coll,converse(Colleq))"
using mono_seqspace_rel_char nat_into_M
by simp
moreover from calculation succ
consider "αâx" | "α=x"
by auto
then
show "â¨f`x, f ` α⩠â Colleq"
proof(cases)
case 1
then
have "â¨Î±, xâ© â Memrel(succ(x))" "xâsucc(x)" "αâsucc(x)"
by auto
with â¹fâsucc(x) â©<â (Coll,converse(Colleq))âº
show ?thesis
using mono_mapD(2)[OF _ â¹Î±âsucc(x)⺠_ â¹â¨Î±, xâ© â Memrel(succ(x))âº]
unfolding mono_seqspace_def
by auto
next
case 2
with â¹fâsucc(x) â©<â (Coll,converse(Colleq))âº
show ?thesis
using Colleq_refl mono_seqspace_is_fun[THEN apply_type]
unfolding refl_def
by simp
qed
qed
moreover
note â¹xâÏâº
moreover from this
have "f`x â Coll" if "f: succ(x) â©<ââMâ (Coll,converse(Colleq))" for f
using that mono_seqspace_rel_char[simplified, of "succ(x)" Coll "converse(Colleq)"]
nat_into_M[simplified] mono_seqspace_is_fun[of "converse(Colleq)"]
by (intro apply_type[of _ "succ(x)"]) (auto simp del:setclass_iff)
ultimately
show ?case
using transM[of _ Coll]
by (auto dest:transM simp del:setclass_iff, rule_tac x="f`x" in bexI)
(auto simp del:setclass_iff, simp)
qed
moreover
have "âfâM. f â Ï â©<ââMâ (Coll,converse(Colleq)) â¶
(âqâM. q â Coll â§ (âαâM. α â Ï â¶ â¨q, f ` α⩠â Colleq))"
proof(intro ballI impI)
fix f
let ?G="f``Ï"
assume "fâM" "f â Ï â©<ââMâ (Coll,converse(Colleq))"
moreover from this
have "fâÏ â©<â (Coll,converse(Colleq))" "fâÏ â Coll"
using mono_seqspace_rel_char mono_mapD(2) nat_in_M
by auto
moreover from this
have "countableâMâ(f`x)" if "xâÏ" for x
using that Fn_rel_is_function countable_iff_lesspoll_rel_Aleph_rel_one
by auto
moreover from calculation
have "?G â M" "fâÏÃColl"
using nat_in_M image_closed Pi_iff
by simp_all
moreover from calculation
have 1:"âdâ?G. d â h â§ d â g" if "h â ?G" "g â ?G" for h g
proof -
from calculation
have "?G={f`x . xâÏ}"
using image_function[of f Ï] Pi_iff domain_of_fun
by auto
from �G=_⺠that
obtain m n where eq:"h=f`m" "g=f`n" "nâÏ" "mâÏ"
by auto
then
have "mâªnâÏ" "mâ¤mâªn" "nâ¤mâªn"
using Un_upper1_le Un_upper2_le nat_into_Ord by simp_all
with calculation eq â¹?G=_âº
have "f`(mâªn)â?G" "f`(mâªn) â h" "f`(mâªn) â g"
using Fnle_relD mono_map_lt_le_is_mono converse_refl[OF Colleq_refl]
by auto
then
show ?thesis
by auto
qed
moreover from calculation
have "?G â (âµâ1ââMâ ââ##Mâ (nat ââMâ 2))"
using subset_trans[OF image_subset[OF â¹fâ_âº,of Ï] Fn_rel_subset_PFun_rel]
by simp
moreover
have "â ?G â (âµâ1ââMâ ââ##Mâ (nat ââMâ 2))"
using pfun_Un_filter_closed'[OF â¹?Gâ_⺠1] â¹?GâMâº
by simp
moreover from calculation
have "â?G âºâMâ âµâ1ââMâ"
using countable_fun_imp_countable_image[of f]
mem_function_space_rel_abs[simplified,OF nat_in_M Coll_in_M â¹fâMâº]
countableI[OF lepoll_rel_refl]
countable_iff_lesspoll_rel_Aleph_rel_one[of "â?G"]
by auto
moreover from calculation
have "â?GâColl"
unfolding Fn_rel_def
by simp
moreover from calculation
have "â?G â f ` α " if "αâÏ" for α
using that image_function[OF fun_is_function] domain_of_fun
by auto
ultimately
show "âqâM. q â Coll â§ (âαâM. α â Ï â¶ â¨q, f ` α⩠â Colleq)"
using Fn_rel_is_function Fnle_relI
by auto
qed
ultimately
show ?thesis
unfolding kappa_closed_rel_def by (auto elim!:leE dest:ltD)
qed
end
locale collapse_generic4 = G_generic4_AC "FnâMâ(âµâ1ââ##Mâ, âµâ1ââMâ, Ï ââMâ 2)" "FnleâMâ(âµâ1ââ##Mâ, âµâ1ââMâ, Ï ââMâ 2)" 0
sublocale collapse_generic4 â forcing_notion "Coll" "Colleq" 0
using zero_lt_Aleph_rel1 by unfold_locales
context collapse_generic4
begin
notation Leq (infixl "â¼" 50)
notation Incompatible (infixl "â¥" 50)
notation GenExt_at_P ("_[_]" [71,1])
abbreviation
f_G :: "i" (â¹fâGââº) where
"fâGâ â¡ âG"
lemma f_G_in_MG[simp]:
shows "fâGâ â M[G]"
using G_in_MG by simp
abbreviation
dom_dense :: "iâi" where
"dom_dense(x) â¡ { pâColl . x â domain(p) }"
lemma Coll_into_countable_rel: "p â Coll â¹ countableâMâ(p)"
proof -
assume "pâColl"
then
have "p âºâMâ âµâ1ââMâ" "pâM"
using Fn_rel_is_function by simp_all
moreover from this
have "p â²âMâ Ï"
using lesspoll_rel_Aleph_rel_succ[of 0] Aleph_rel_zero
by simp
ultimately
show ?thesis
using countableI eqpoll_rel_imp_lepoll_rel eqpoll_rel_sym cardinal_rel_eqpoll_rel
by simp
qed
lemma dense_dom_dense: "x â âµâ1ââMâ â¹ dense(dom_dense(x))"
proof
fix p
assume "x â âµâ1ââMâ" "p â Coll"
show "âdâdom_dense(x). d â¼ p"
proof (cases "x â domain(p)")
case True
with â¹x â âµâ1ââMâ⺠â¹p â Collâº
show ?thesis using refl_leq by auto
next
case False
note â¹p â Collâº
moreover from this and False and â¹x â âµâ1ââMââº
have "cons(â¨x,λnâÏ. 0â©, p) â Coll" "xâM"
using function_space_rel_char
function_space_rel_closed lam_replacement_constant
lam_replacement_iff_lam_closed InfCard_rel_Aleph_rel
by (auto intro!: cons_in_Fn_rel dest:transM intro:function_space_nonempty)
ultimately
show ?thesis
using Fn_relD by blast
qed
qed
lemma dom_dense_closed[intro,simp]: "xâM â¹ dom_dense(x) â M"
using separation_in_domain[of x]
by simp
lemma domain_f_G: assumes "x â âµâ1ââMâ"
shows "x â domain(fâGâ)"
proof -
from assms
have "dense(dom_dense(x))" "xâM"
using dense_dom_dense transitivity[OF _
Aleph_rel_closed[of 1,THEN setclass_iff[THEN iffD1]]]
by simp_all
with assms
obtain p where "pâdom_dense(x)" "pâG"
using generic[THEN M_generic_denseD, of "dom_dense(x)"]
by auto
then
show "x â domain(fâGâ)" by blast
qed
lemma rex_mono : assumes "â d â A . P(d)" "AâB"
shows "â d â B. P(d)"
using assms by auto
lemma Un_filter_is_function:
assumes "filter(G)"
shows "function(âG)"
proof -
have "Coll â âµâ1ââMâ ââ##Mâ (Ï ââMâ 2)"
using Fn_rel_subset_PFun_rel
by simp
moreover
have "â d â Coll. d â f â§ d â g" if "fâG" "gâG" for f g
using filter_imp_compat[OF assms â¹fâG⺠â¹gâGâº] filterD[OF assms]
unfolding compat_def compat_in_def
by auto
ultimately
have "âd â âµâ1ââMâ ââ##Mâ (Ï ââMâ 2). d â f â§ d â g" if "fâG" "gâG" for f g
using rex_mono[of Coll] that by simp
moreover
have "GâColl"
using assms
unfolding filter_def
by simp
moreover from this
have "G â âµâ1ââMâ ââ##Mâ (Ï ââMâ 2)"
using assms unfolding Fn_rel_def
by auto
ultimately
show ?thesis
using pfun_Un_filter_closed[of G]
by simp
qed
lemma f_G_funtype:
shows "fâGâ : âµâ1ââMâ â Ï ââM[G]â 2"
proof -
have "x â B â¹ B â G â¹ x â âµâ1ââMâ à (Ï ââM[G]â 2)" for B x
proof -
assume "xâB" "BâG"
moreover from this
have "x â M[G]"
by (auto dest!:generic_dests ext.transM)
(intro generic_simps(2)[of Coll], simp)
moreover from calculation
have "x â âµâ1ââMâ à (Ï â 2)"
using Fn_rel_subset_Pow[of "âµâ1ââMâ" "âµâ1ââMâ" "Ï ââMâ 2",
OF _ _ function_space_rel_closed] function_space_rel_char
by (auto dest!:generic_dests)
moreover from this
obtain z w where "x=â¨z,wâ©" "zââµâ1ââMâ" "w:Ï â 2" by auto
moreover from calculation
have "w â M[G]" by (auto dest:ext.transM)
ultimately
show ?thesis using ext.function_space_rel_char by auto
qed
moreover
have "function(fâGâ)"
using Un_filter_is_function generic
unfolding M_generic_def by fast
ultimately
show ?thesis
using generic domain_f_G unfolding Pi_def by auto
qed
abbreviation
surj_dense :: "iâi" where
"surj_dense(x) â¡ { pâColl . x â range(p) }"
lemma dense_surj_dense:
assumes "x â Ï ââMâ 2"
shows "dense(surj_dense(x))"
proof
fix p
assume "p â Coll"
then
have "countableâMâ(p)" using Coll_into_countable_rel by simp
show "âdâsurj_dense(x). d â¼ p"
proof -
from â¹p â Collâº
have "domain(p) â âµâ1ââMâ" "pâM"
using transM[of _ Coll] domain_of_fun
by (auto del:Fn_relD dest!:Fn_relD del:domainE)
moreover from â¹countableâMâ(p)âº
have "domain(p) â {fst(x) . x â p }" by (auto intro!: rev_bexI)
moreover from calculation
have "{ fst(x) . x â p } â M"
using lam_replacement_fst[THEN lam_replacement_imp_strong_replacement]
by (auto simp flip:setclass_iff intro!:RepFun_closed dest:transM)
moreover from calculation and â¹countableâMâ(p)âº
have "countableâMâ({fst(x) . x â p })"
using cardinal_rel_RepFun_le lam_replacement_fst
countable_rel_iff_cardinal_rel_le_nat[THEN iffD1, THEN [2] le_trans, of _ p]
by (rule_tac countable_rel_iff_cardinal_rel_le_nat[THEN iffD2]) simp_all
moreover from calculation
have "countableâMâ(domain(p))"
using uncountable_rel_not_subset_countable_rel[of "{fst(x) . x â p }" "domain(p)"]
by auto
ultimately
obtain α where "α â domain(p)" "αââµâ1ââMâ"
using lt_cardinal_rel_imp_not_subset[of "domain(p)" "âµâ1ââMâ"]
Ord_Aleph_rel countable_iff_le_rel_Aleph_rel_one[THEN iffD1,
THEN lesspoll_cardinal_lt_rel, of "domain(p)"]
cardinal_rel_idem by auto
moreover note assms
moreover from calculation and â¹p â Collâº
have "cons(â¨Î±,xâ©, p) â Coll" "xâM" "cons(â¨Î±,xâ©, p) â¼ p"
using InfCard_rel_Aleph_rel
by (auto del:Fnle_relI intro!: cons_in_Fn_rel Fnle_relI dest:transM)
ultimately
show ?thesis by blast
qed
qed
lemma surj_dense_closed[intro,simp]:
"x â Ï ââMâ 2 â¹ surj_dense(x) â M"
using separation_in_range transM[of x] by simp
lemma reals_sub_image_f_G:
assumes "xâÏ ââMâ 2"
shows "âαââµâ1ââMâ. fâGâ ` α = x"
proof -
from assms
have "dense(surj_dense(x))" using dense_surj_dense by simp
with â¹x â Ï ââMâ 2âº
obtain p where "pâsurj_dense(x)" "pâG"
using generic[THEN M_generic_denseD, of "surj_dense(x)"]
by blast
then
show ?thesis
using succ_omega_closed_Coll f_G_funtype function_apply_equality[of _ x f_G]
succ_omega_closed_imp_no_new_reals[symmetric]
by (auto, rule_tac bexI) (auto simp:Pi_def)
qed
lemma f_G_surj_Aleph_rel1_reals: "fâGâ â surjâM[G]â(âµâ1ââMâ, Ï ââM[G]â 2)"
using Aleph_rel_sub_closed
proof (intro ext.mem_surj_abs[THEN iffD2])
show "fâGâ â surj(âµâ1ââMâ, Ï ââM[G]â 2)"
unfolding surj_def
proof (intro ballI CollectI impI)
show "fâGâ â âµâ1ââMâ â Ï ââM[G]â 2"
using f_G_funtype G_in_MG ext.nat_into_M f_G_in_MG by simp
fix x
assume "x â Ï ââM[G]â 2"
then
show "âαââµâ1ââMâ. fâGâ ` α = x"
using reals_sub_image_f_G succ_omega_closed_Coll
f_G_funtype succ_omega_closed_imp_no_new_reals by simp
qed
qed simp_all
lemma continuum_rel_le_Aleph1_extension:
includes G_generic1_lemmas
shows "2âââµâ0ââM[G]â,M[G]â ⤠âµâ1ââM[G]â"
proof -
have "âµâ1ââMâ â M[G]" "Ord(âµâ1ââMâ)"
using Card_rel_is_Ord by auto
moreover from this
have "Ï ââM[G]â 2 â²âM[G]â âµâ1ââMâ"
using ext.surj_rel_implies_inj_rel[OF f_G_surj_Aleph_rel1_reals]
f_G_in_MG unfolding lepoll_rel_def by auto
with â¹Ord(âµâ1ââMâ)âº
have "|Ï ââM[G]â 2|âM[G]â ⤠|âµâ1ââMâ|âM[G]â"
using M_subset_MG[OF one_in_G, OF generic] Aleph_rel_closed[of 1]
by (rule_tac ext.lepoll_rel_imp_cardinal_rel_le) simp_all
ultimately
have "2âââµâ0ââM[G]â,M[G]â ⤠|âµâ1ââM[G]â|âM[G]â"
using ext.lepoll_rel_imp_cardinal_rel_le[of "âµâ1ââMâ" "Ï ââM[G]â 2"]
ext.Aleph_rel_zero succ_omega_closed_Coll
succ_omega_closed_imp_Aleph_1_preserved
unfolding cexp_rel_def by simp
then
show "2âââµâ0ââM[G]â,M[G]â ⤠âµâ1ââM[G]â" by simp
qed
theorem CH: "âµâ1ââM[G]â = 2âââµâ0ââM[G]â,M[G]â"
using continuum_rel_le_Aleph1_extension ext.Aleph_rel_succ[of 0]
ext.Aleph_rel_zero ext.csucc_rel_le[of "2âââµâ0ââM[G]â,M[G]â" Ï]
ext.Card_rel_cexp_rel ext.cantor_cexp_rel[of Ï] ext.Card_rel_nat
le_anti_sym
by auto
end
subsectionâ¹Models of fragments of $\ZFC + \CH$âº
theorem ctm_of_CH:
assumes
"M â Ï" "Transset(M)" "M ⨠ZC ⪠{â
Replacement(p)â
. p â overhead}"
"Φ â formula" "M ⨠{ â
Replacement(ground_repl_fm(Ï))â
. Ï â Φ}"
shows
"âN.
M â N â§ N â Ï â§ Transset(N) â§ N ⨠ZC ⪠{â
CHâ
} ⪠{ â
Replacement(Ï)â
. Ï â Φ} â§
(âα. Ord(α) â¶ (α â M ⷠα â N))"
proof -
from â¹M ⨠ZC ⪠{â
Replacement(p)â
. p â overhead}âº
interpret M_ZFC4 M
using M_satT_overhead_imp_M_ZF4 by simp
from â¹Transset(M)âº
interpret M_ZFC4_trans M
using M_satT_imp_M_ZF4
by unfold_locales
from â¹M â Ïâº
obtain enum where "enum â bij(Ï,M)"
using eqpoll_sym unfolding eqpoll_def by blast
then
interpret M_ctm3_AC M enum by unfold_locales
interpret forcing_data1 "Coll" "Colleq" 0 M enum
using zero_in_Fn_rel[of "âµâ1ââMâ" "âµâ1ââMâ" "Ï ââMâ 2"]
zero_top_Fn_rel[of _ "âµâ1ââMâ" "âµâ1ââMâ" "Ï ââMâ 2"]
preorder_on_Fnle_rel[of "âµâ1ââMâ" "âµâ1ââMâ" "Ï ââMâ 2"]
zero_lt_Aleph_rel1
by unfold_locales simp_all
obtain G where "M_generic(G)"
using generic_filter_existence[OF one_in_P]
by auto
moreover from this
interpret collapse_generic4 M enum G by unfold_locales
have "âµâ1ââM[G]â = 2âââµâ0ââM[G]â,M[G]â"
using CH .
then
have "M[G], [] ⨠â
CHâ
"
using ext.is_ContHyp_iff
by (simp add:ContHyp_rel_def)
then
have "M[G] ⨠ZC ⪠{â
CHâ
}"
using ext.M_satT_ZC by auto
moreover
have "Transset(M[G])" using Transset_MG .
moreover
have "M â M[G]" using M_subset_MG[OF one_in_G] generic by simp
moreover
note â¹M ⨠{ â
Replacement(ground_repl_fm(Ï))â
. Ï â Φ}⺠â¹Î¦ â formulaâº
ultimately
show ?thesis
using Ord_MG_iff MG_eqpoll_nat satT_ground_repl_fm_imp_satT_ZF_replacement_fm[of Φ]
by (rule_tac x="M[G]" in exI,blast)
qed
corollary ctm_ZFC_imp_ctm_CH:
assumes
"M â Ï" "Transset(M)" "M ⨠ZFC"
shows
"âN.
M â N â§ N â Ï â§ Transset(N) â§ N ⨠ZFC ⪠{â
CHâ
} â§
(âα. Ord(α) â¶ (α â M ⷠα â N))"
proof -
from assms
have "âN.
M â N â§
N â Ï â§
Transset(N) â§
N ⨠ZC â§ N ⨠{â
CHâ
} â§ N ⨠{â
Replacement(x)â
. x â formula} â§ (âα. Ord(α) ⶠα â M ⷠα â N)"
using ctm_of_CH[of M formula] satT_ZFC_imp_satT_ZC[of M]
satT_mono[OF _ ground_repl_fm_sub_ZFC, of M]
satT_mono[OF _ ZF_replacement_overhead_sub_ZFC, of M]
satT_mono[OF _ ZF_replacement_fms_sub_ZFC, of M]
by (simp add: satT_Un_iff)
then
obtain N where "N ⨠ZC" "N ⨠{â
CHâ
}" "N ⨠{â
Replacement(x)â
. x â formula}"
"M â N" "N â Ï" "Transset(N)" "(âα. Ord(α) ⶠα â M ⷠα â N)"
by auto
moreover from this
have "N ⨠ZFC"
using satT_ZC_ZF_replacement_imp_satT_ZFC
by auto
moreover from this and â¹N ⨠{â
CHâ
}âº
have "N ⨠ZFC ⪠{â
CHâ
}"
using satT_ZC_ZF_replacement_imp_satT_ZFC
by auto
ultimately
show ?thesis
by auto
qed
end
Theory Absolute_Versions
sectionâ¹From $M$ to $\calV$âº
theory Absolute_Versions
imports
CH
ZF.Cardinal_AC
begin
subsectionâ¹Locales of a class \<^term>â¹M⺠hold in \<^term>â¹ð±âºâº